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,gradafm !(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 Eafmforce,ethetacnstr
227 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
230 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
231 ! shielding effect varibles for MPI
232 ! real(kind=8) fac_shieldbuf(maxres),
233 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
234 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
235 ! & grad_shieldbuf(3,-1:maxres)
236 ! integer ishield_listbuf(maxres),
237 ! &shield_listbuf(maxcontsshi,maxres)
239 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
240 ! & " nfgtasks",nfgtasks
241 if (nfgtasks.gt.1) then
243 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
244 if (fg_rank.eq.0) then
245 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
246 ! print *,"Processor",myrank," BROADCAST iorder"
247 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
248 ! FG slaves as WEIGHTS array.
268 ! FG Master broadcasts the WEIGHTS_ array
269 call MPI_Bcast(weights_(1),n_ene,&
270 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
272 ! FG slaves receive the WEIGHTS array
273 call MPI_Bcast(weights(1),n_ene,&
274 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
295 time_Bcast=time_Bcast+MPI_Wtime()-time00
296 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
297 ! call chainbuild_cart
299 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
300 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
302 ! if (modecalc.eq.12.or.modecalc.eq.14) then
303 ! call int_from_cart1(.false.)
310 ! Compute the side-chain and electrostatic interaction energy
311 ! print *, "Before EVDW"
312 ! goto (101,102,103,104,105,106) ipot
314 ! Lennard-Jones potential.
318 !d print '(a)','Exit ELJcall el'
320 ! Lennard-Jones-Kihara potential (shifted).
321 ! 102 call eljk(evdw)
325 ! Berne-Pechukas potential (dilated LJ, angular dependence).
330 ! Gay-Berne potential (shifted LJ, angular dependence).
335 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
336 ! 105 call egbv(evdw)
340 ! Soft-sphere potential
341 ! 106 call e_softsphere(evdw)
343 call e_softsphere(evdw)
345 ! Calculate electrostatic (H-bonding) energy of the main chain.
349 write(iout,*)"Wrong ipot"
354 ! print *,"after EGB"
356 if (shield_mode.eq.2) then
360 !mc Sep-06: egb takes care of dynamic ss bonds too
362 ! if (dyn_ss) call dyn_set_nss
363 ! print *,"Processor",myrank," computed USCSC"
369 time_vec=time_vec+MPI_Wtime()-time01
371 ! print *,"Processor",myrank," left VEC_AND_DERIV"
374 ! print *,"after ipot if", ipot
375 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
376 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
377 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
378 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
380 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
381 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
382 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
383 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
385 ! print *,"just befor eelec call"
386 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
387 ! write (iout,*) "ELEC calc"
396 ! write (iout,*) "Soft-spheer ELEC potential"
397 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
400 ! print *,"Processor",myrank," computed UELEC"
402 ! Calculate excluded-volume interaction energy between peptide groups
405 !elwrite(iout,*) "in etotal calc exc;luded",ipot
409 call escp(evdw2,evdw2_14)
415 ! write (iout,*) "Soft-sphere SCP potential"
416 call escp_soft_sphere(evdw2,evdw2_14)
418 ! write(iout,*) "in etotal before ebond",ipot
421 ! Calculate the bond-stretching energy
424 ! write(iout,*) "in etotal afer ebond",ipot
427 ! Calculate the disulfide-bridge and other energy and the contributions
428 ! from other distance constraints.
429 ! print *,'Calling EHPB'
431 !elwrite(iout,*) "in etotal afer edis",ipot
432 ! print *,'EHPB exitted succesfully.'
434 ! Calculate the virtual-bond-angle energy.
436 if (wang.gt.0d0) then
437 call ebend(ebe,ethetacnstr)
441 ! print *,"Processor",myrank," computed UB"
443 ! Calculate the SC local energy.
446 !elwrite(iout,*) "in etotal afer esc",ipot
447 ! print *,"Processor",myrank," computed USC"
449 ! Calculate the virtual-bond torsional energy.
451 !d print *,'nterm=',nterm
453 call etor(etors,edihcnstr)
458 ! print *,"Processor",myrank," computed Utor"
460 ! 6/23/01 Calculate double-torsional energy
462 !elwrite(iout,*) "in etotal",ipot
463 if (wtor_d.gt.0) then
468 ! print *,"Processor",myrank," computed Utord"
470 ! 21/5/07 Calculate local sicdechain correlation energy
472 if (wsccor.gt.0.0d0) then
473 call eback_sc_corr(esccor)
477 ! print *,"Processor",myrank," computed Usccorr"
479 ! 12/1/95 Multi-body terms
483 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
484 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
485 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
486 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
487 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
494 !elwrite(iout,*) "in etotal",ipot
495 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
496 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
497 !d write (iout,*) "multibody_hb ecorr",ecorr
499 !elwrite(iout,*) "afeter multibody hb"
501 ! print *,"Processor",myrank," computed Ucorr"
503 ! If performing constraint dynamics, call the constraint energy
504 ! after the equilibration time
505 if(usampl.and.totT.gt.eq_time) then
506 !elwrite(iout,*) "afeter multibody hb"
508 !elwrite(iout,*) "afeter multibody hb"
510 !elwrite(iout,*) "afeter multibody hb"
516 ! write(iout,*) "after Econstr"
518 if (wliptran.gt.0) then
519 ! print *,"PRZED WYWOLANIEM"
520 call Eliptransfer(eliptran)
524 if (fg_rank.eq.0) then
525 if (AFMlog.gt.0) then
526 call AFMforce(Eafmforce)
527 else if (selfguide.gt.0) then
528 call AFMvel(Eafmforce)
531 if (tubemode.eq.1) then
533 else if (tubemode.eq.2) then
534 call calctube2(etube)
535 elseif (tubemode.eq.3) then
542 time_enecalc=time_enecalc+MPI_Wtime()-time00
544 ! print *,"Processor",myrank," computed Uconstr"
553 energia(2)=evdw2-evdw2_14
570 energia(8)=eello_turn3
571 energia(9)=eello_turn4
578 energia(19)=edihcnstr
580 energia(20)=Uconst+Uconst_back
583 energia(23)=Eafmforce
584 energia(24)=ethetacnstr
586 ! Here are the energies showed per procesor if the are more processors
587 ! per molecule then we sum it up in sum_energy subroutine
588 ! print *," Processor",myrank," calls SUM_ENERGY"
589 call sum_energy(energia,.true.)
590 if (dyn_ss) call dyn_set_nss
591 ! print *," Processor",myrank," left SUM_ENERGY"
593 time_sumene=time_sumene+MPI_Wtime()-time00
595 !el call enerprint(energia)
596 !elwrite(iout,*)"finish etotal"
598 end subroutine etotal
599 !-----------------------------------------------------------------------------
600 subroutine sum_energy(energia,reduce)
601 ! implicit real*8 (a-h,o-z)
602 ! include 'DIMENSIONS'
606 !MS$ATTRIBUTES C :: proc_proc
612 ! include 'COMMON.SETUP'
613 ! include 'COMMON.IOUNITS'
614 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
615 ! include 'COMMON.FFIELD'
616 ! include 'COMMON.DERIV'
617 ! include 'COMMON.INTERACT'
618 ! include 'COMMON.SBRIDGE'
619 ! include 'COMMON.CHAIN'
620 ! include 'COMMON.VAR'
621 ! include 'COMMON.CONTROL'
622 ! include 'COMMON.TIME1'
624 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
625 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
626 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
627 eliptran,etube, Eafmforce,ethetacnstr
631 real(kind=8) :: time00
632 if (nfgtasks.gt.1 .and. reduce) then
635 write (iout,*) "energies before REDUCE"
636 call enerprint(energia)
640 enebuff(i)=energia(i)
643 call MPI_Barrier(FG_COMM,IERR)
644 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
646 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
647 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
649 write (iout,*) "energies after REDUCE"
650 call enerprint(energia)
653 time_Reduce=time_Reduce+MPI_Wtime()-time00
655 if (fg_rank.eq.0) then
659 evdw2=energia(2)+energia(18)
675 eello_turn3=energia(8)
676 eello_turn4=energia(9)
683 edihcnstr=energia(19)
688 Eafmforce=energia(23)
689 ethetacnstr=energia(24)
692 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
693 +wang*ebe+wtor*etors+wscloc*escloc &
694 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
695 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
696 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
697 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
698 +Eafmforce+ethetacnstr
700 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
701 +wang*ebe+wtor*etors+wscloc*escloc &
702 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
703 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
704 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
705 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
706 +Eafmforce+ethetacnstr
713 if (isnan(etot).ne.0) energia(0)=1.0d+99
715 if (isnan(etot)) energia(0)=1.0d+99
720 idumm=proc_proc(etot,i)
722 call proc_proc(etot,i)
724 if(i.eq.1)energia(0)=1.0d+99
729 ! call enerprint(energia)
732 end subroutine sum_energy
733 !-----------------------------------------------------------------------------
734 subroutine rescale_weights(t_bath)
735 ! implicit real*8 (a-h,o-z)
739 ! include 'DIMENSIONS'
740 ! include 'COMMON.IOUNITS'
741 ! include 'COMMON.FFIELD'
742 ! include 'COMMON.SBRIDGE'
743 real(kind=8) :: kfac=2.4d0
744 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
746 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
747 real(kind=8) :: T0=3.0d2
750 ! facT=2*temp0/(t_bath+temp0)
751 if (rescale_mode.eq.0) then
758 else if (rescale_mode.eq.1) then
759 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
760 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
761 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
762 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
763 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
765 !#if defined(WHAM_RUN) || defined(CLUSTER)
767 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
768 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
775 else if (rescale_mode.eq.2) then
781 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
782 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
783 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
784 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
785 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
787 !#if defined(WHAM_RUN) || defined(CLUSTER)
789 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
797 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
798 write (*,*) "Wrong RESCALE_MODE",rescale_mode
800 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
804 welec=weights(3)*fact(1)
805 wcorr=weights(4)*fact(3)
806 wcorr5=weights(5)*fact(4)
807 wcorr6=weights(6)*fact(5)
808 wel_loc=weights(7)*fact(2)
809 wturn3=weights(8)*fact(2)
810 wturn4=weights(9)*fact(3)
811 wturn6=weights(10)*fact(5)
812 wtor=weights(13)*fact(1)
813 wtor_d=weights(14)*fact(2)
814 wsccor=weights(21)*fact(1)
817 end subroutine rescale_weights
818 !-----------------------------------------------------------------------------
819 subroutine enerprint(energia)
820 ! implicit real*8 (a-h,o-z)
821 ! include 'DIMENSIONS'
822 ! include 'COMMON.IOUNITS'
823 ! include 'COMMON.FFIELD'
824 ! include 'COMMON.SBRIDGE'
825 ! include 'COMMON.MD'
826 real(kind=8) :: energia(0:n_ene)
828 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
829 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
830 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
831 etube,ethetacnstr,Eafmforce
837 evdw2=energia(2)+energia(18)
849 eello_turn3=energia(8)
850 eello_turn4=energia(9)
851 eello_turn6=energia(10)
857 edihcnstr=energia(19)
862 Eafmforce=energia(23)
863 ethetacnstr=energia(24)
866 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
867 estr,wbond,ebe,wang,&
868 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
870 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
871 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
872 edihcnstr,ethetacnstr,ebr*nss,&
873 Uconst,eliptran,wliptran,Eafmforce,etube,wtube,etot
874 10 format (/'Virtual-chain energies:'// &
875 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
876 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
877 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
878 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
879 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
880 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
881 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
882 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
883 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
884 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
885 ' (SS bridges & dist. cnstr.)'/ &
886 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
887 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
888 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
889 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
890 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
891 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
892 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
893 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
894 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
895 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
896 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
897 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
898 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
899 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
900 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
901 'ETOT= ',1pE16.6,' (total)')
903 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
904 estr,wbond,ebe,wang,&
905 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
907 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
908 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
909 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
911 10 format (/'Virtual-chain energies:'// &
912 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
913 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
914 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
915 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
916 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
917 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
918 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
919 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
920 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
921 ' (SS bridges & dist. cnstr.)'/ &
922 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
923 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
924 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
925 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
926 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
927 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
928 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
929 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
930 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
931 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
932 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
933 'UCONST=',1pE16.6,' (Constraint energy)'/ &
934 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
935 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
936 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
937 'ETOT= ',1pE16.6,' (total)')
940 end subroutine enerprint
941 !-----------------------------------------------------------------------------
944 ! This subroutine calculates the interaction energy of nonbonded side chains
945 ! assuming the LJ potential of interaction.
947 ! implicit real*8 (a-h,o-z)
948 ! include 'DIMENSIONS'
949 real(kind=8),parameter :: accur=1.0d-10
950 ! include 'COMMON.GEO'
951 ! include 'COMMON.VAR'
952 ! include 'COMMON.LOCAL'
953 ! include 'COMMON.CHAIN'
954 ! include 'COMMON.DERIV'
955 ! include 'COMMON.INTERACT'
956 ! include 'COMMON.TORSION'
957 ! include 'COMMON.SBRIDGE'
958 ! include 'COMMON.NAMES'
959 ! include 'COMMON.IOUNITS'
960 ! include 'COMMON.CONTACTS'
961 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
964 integer :: i,itypi,iint,j,itypi1,itypj,k
965 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
966 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
967 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
969 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
971 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
972 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
973 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
974 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
977 itypi=iabs(itype(i,1))
978 if (itypi.eq.ntyp1) cycle
979 itypi1=iabs(itype(i+1,1))
986 ! Calculate SC interaction energy.
989 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
990 !d & 'iend=',iend(i,iint)
991 do j=istart(i,iint),iend(i,iint)
992 itypj=iabs(itype(j,1))
993 if (itypj.eq.ntyp1) cycle
997 ! Change 12/1/95 to calculate four-body interactions
998 rij=xj*xj+yj*yj+zj*zj
1000 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1001 eps0ij=eps(itypi,itypj)
1003 e1=fac*fac*aa_aq(itypi,itypj)
1004 e2=fac*bb_aq(itypi,itypj)
1006 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1007 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1008 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1009 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1010 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1011 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1014 ! Calculate the components of the gradient in DC and X
1016 fac=-rrij*(e1+evdwij)
1021 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1022 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1023 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1024 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1028 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1032 ! 12/1/95, revised on 5/20/97
1034 ! Calculate the contact function. The ith column of the array JCONT will
1035 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1036 ! greater than I). The arrays FACONT and GACONT will contain the values of
1037 ! the contact function and its derivative.
1039 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1040 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1041 ! Uncomment next line, if the correlation interactions are contact function only
1042 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1044 sigij=sigma(itypi,itypj)
1045 r0ij=rs0(itypi,itypj)
1047 ! Check whether the SC's are not too far to make a contact.
1050 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1051 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1053 if (fcont.gt.0.0D0) then
1054 ! If the SC-SC distance if close to sigma, apply spline.
1055 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1056 !Adam & fcont1,fprimcont1)
1057 !Adam fcont1=1.0d0-fcont1
1058 !Adam if (fcont1.gt.0.0d0) then
1059 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1060 !Adam fcont=fcont*fcont1
1062 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1063 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1065 !ga gg(k)=gg(k)*eps0ij
1067 !ga eps0ij=-evdwij*eps0ij
1068 ! Uncomment for AL's type of SC correlation interactions.
1069 !adam eps0ij=-evdwij
1070 num_conti=num_conti+1
1071 jcont(num_conti,i)=j
1072 facont(num_conti,i)=fcont*eps0ij
1073 fprimcont=eps0ij*fprimcont/rij
1075 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1076 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1077 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1078 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1079 gacont(1,num_conti,i)=-fprimcont*xj
1080 gacont(2,num_conti,i)=-fprimcont*yj
1081 gacont(3,num_conti,i)=-fprimcont*zj
1082 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1083 !d write (iout,'(2i3,3f10.5)')
1084 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1090 num_cont(i)=num_conti
1094 gvdwc(j,i)=expon*gvdwc(j,i)
1095 gvdwx(j,i)=expon*gvdwx(j,i)
1098 !******************************************************************************
1102 ! To save time, the factor of EXPON has been extracted from ALL components
1103 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1106 !******************************************************************************
1109 !-----------------------------------------------------------------------------
1110 subroutine eljk(evdw)
1112 ! This subroutine calculates the interaction energy of nonbonded side chains
1113 ! assuming the LJK potential of interaction.
1115 ! implicit real*8 (a-h,o-z)
1116 ! include 'DIMENSIONS'
1117 ! include 'COMMON.GEO'
1118 ! include 'COMMON.VAR'
1119 ! include 'COMMON.LOCAL'
1120 ! include 'COMMON.CHAIN'
1121 ! include 'COMMON.DERIV'
1122 ! include 'COMMON.INTERACT'
1123 ! include 'COMMON.IOUNITS'
1124 ! include 'COMMON.NAMES'
1125 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1128 integer :: i,iint,j,itypi,itypi1,k,itypj
1129 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1130 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1132 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1134 do i=iatsc_s,iatsc_e
1135 itypi=iabs(itype(i,1))
1136 if (itypi.eq.ntyp1) cycle
1137 itypi1=iabs(itype(i+1,1))
1142 ! Calculate SC interaction energy.
1144 do iint=1,nint_gr(i)
1145 do j=istart(i,iint),iend(i,iint)
1146 itypj=iabs(itype(j,1))
1147 if (itypj.eq.ntyp1) cycle
1151 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1152 fac_augm=rrij**expon
1153 e_augm=augm(itypi,itypj)*fac_augm
1154 r_inv_ij=dsqrt(rrij)
1156 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1157 fac=r_shift_inv**expon
1158 e1=fac*fac*aa_aq(itypi,itypj)
1159 e2=fac*bb_aq(itypi,itypj)
1161 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1162 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1163 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1164 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1165 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1166 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1167 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1170 ! Calculate the components of the gradient in DC and X
1172 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1177 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1178 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1179 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1180 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1184 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1192 gvdwc(j,i)=expon*gvdwc(j,i)
1193 gvdwx(j,i)=expon*gvdwx(j,i)
1198 !-----------------------------------------------------------------------------
1199 subroutine ebp(evdw)
1201 ! This subroutine calculates the interaction energy of nonbonded side chains
1202 ! assuming the Berne-Pechukas potential of interaction.
1206 ! implicit real*8 (a-h,o-z)
1207 ! include 'DIMENSIONS'
1208 ! include 'COMMON.GEO'
1209 ! include 'COMMON.VAR'
1210 ! include 'COMMON.LOCAL'
1211 ! include 'COMMON.CHAIN'
1212 ! include 'COMMON.DERIV'
1213 ! include 'COMMON.NAMES'
1214 ! include 'COMMON.INTERACT'
1215 ! include 'COMMON.IOUNITS'
1216 ! include 'COMMON.CALC'
1218 !el integer :: icall
1219 !el common /srutu/ icall
1220 ! double precision rrsave(maxdim)
1223 integer :: iint,itypi,itypi1,itypj
1224 real(kind=8) :: rrij,xi,yi,zi
1225 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1227 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1229 ! if (icall.eq.0) then
1235 do i=iatsc_s,iatsc_e
1236 itypi=iabs(itype(i,1))
1237 if (itypi.eq.ntyp1) cycle
1238 itypi1=iabs(itype(i+1,1))
1242 dxi=dc_norm(1,nres+i)
1243 dyi=dc_norm(2,nres+i)
1244 dzi=dc_norm(3,nres+i)
1245 ! dsci_inv=dsc_inv(itypi)
1246 dsci_inv=vbld_inv(i+nres)
1248 ! Calculate SC interaction energy.
1250 do iint=1,nint_gr(i)
1251 do j=istart(i,iint),iend(i,iint)
1253 itypj=iabs(itype(j,1))
1254 if (itypj.eq.ntyp1) cycle
1255 ! dscj_inv=dsc_inv(itypj)
1256 dscj_inv=vbld_inv(j+nres)
1257 chi1=chi(itypi,itypj)
1258 chi2=chi(itypj,itypi)
1265 alf12=0.5D0*(alf1+alf2)
1266 ! For diagnostics only!!!
1279 dxj=dc_norm(1,nres+j)
1280 dyj=dc_norm(2,nres+j)
1281 dzj=dc_norm(3,nres+j)
1282 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1283 !d if (icall.eq.0) then
1289 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1291 ! Calculate whole angle-dependent part of epsilon and contributions
1292 ! to its derivatives
1293 fac=(rrij*sigsq)**expon2
1294 e1=fac*fac*aa_aq(itypi,itypj)
1295 e2=fac*bb_aq(itypi,itypj)
1296 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1297 eps2der=evdwij*eps3rt
1298 eps3der=evdwij*eps2rt
1299 evdwij=evdwij*eps2rt*eps3rt
1302 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1303 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1304 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1305 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1306 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1307 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1308 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1311 ! Calculate gradient components.
1312 e1=e1*eps1*eps2rt**2*eps3rt**2
1313 fac=-expon*(e1+evdwij)
1316 ! Calculate radial part of the gradient
1320 ! Calculate the angular part of the gradient and sum add the contributions
1321 ! to the appropriate components of the Cartesian gradient.
1329 !-----------------------------------------------------------------------------
1330 subroutine egb(evdw)
1332 ! This subroutine calculates the interaction energy of nonbonded side chains
1333 ! assuming the Gay-Berne potential of interaction.
1336 ! implicit real*8 (a-h,o-z)
1337 ! include 'DIMENSIONS'
1338 ! include 'COMMON.GEO'
1339 ! include 'COMMON.VAR'
1340 ! include 'COMMON.LOCAL'
1341 ! include 'COMMON.CHAIN'
1342 ! include 'COMMON.DERIV'
1343 ! include 'COMMON.NAMES'
1344 ! include 'COMMON.INTERACT'
1345 ! include 'COMMON.IOUNITS'
1346 ! include 'COMMON.CALC'
1347 ! include 'COMMON.CONTROL'
1348 ! include 'COMMON.SBRIDGE'
1351 integer :: iint,itypi,itypi1,itypj,subchap
1352 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1353 real(kind=8) :: evdw,sig0ij
1354 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1355 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1356 sslipi,sslipj,faclip
1358 real(kind=8) :: fracinbuf
1360 !cccc energy_dec=.false.
1361 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1364 ! if (icall.eq.0) lprn=.false.
1366 do i=iatsc_s,iatsc_e
1367 !C print *,"I am in EVDW",i
1368 itypi=iabs(itype(i,1))
1369 ! if (i.ne.47) cycle
1370 if (itypi.eq.ntyp1) cycle
1371 itypi1=iabs(itype(i+1,1))
1375 xi=dmod(xi,boxxsize)
1376 if (xi.lt.0) xi=xi+boxxsize
1377 yi=dmod(yi,boxysize)
1378 if (yi.lt.0) yi=yi+boxysize
1379 zi=dmod(zi,boxzsize)
1380 if (zi.lt.0) zi=zi+boxzsize
1382 if ((zi.gt.bordlipbot) &
1383 .and.(zi.lt.bordliptop)) then
1384 !C the energy transfer exist
1385 if (zi.lt.buflipbot) then
1386 !C what fraction I am in
1388 ((zi-bordlipbot)/lipbufthick)
1389 !C lipbufthick is thickenes of lipid buffore
1390 sslipi=sscalelip(fracinbuf)
1391 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1392 elseif (zi.gt.bufliptop) then
1393 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1394 sslipi=sscalelip(fracinbuf)
1395 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1404 ! print *, sslipi,ssgradlipi
1405 dxi=dc_norm(1,nres+i)
1406 dyi=dc_norm(2,nres+i)
1407 dzi=dc_norm(3,nres+i)
1408 ! dsci_inv=dsc_inv(itypi)
1409 dsci_inv=vbld_inv(i+nres)
1410 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1411 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1413 ! Calculate SC interaction energy.
1415 do iint=1,nint_gr(i)
1416 do j=istart(i,iint),iend(i,iint)
1417 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1418 call dyn_ssbond_ene(i,j,evdwij)
1420 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1421 'evdw',i,j,evdwij,' ss'
1422 ! if (energy_dec) write (iout,*) &
1423 ! 'evdw',i,j,evdwij,' ss'
1424 do k=j+1,iend(i,iint)
1425 !C search over all next residues
1426 if (dyn_ss_mask(k)) then
1427 !C check if they are cysteins
1428 !C write(iout,*) 'k=',k
1430 !c write(iout,*) "PRZED TRI", evdwij
1431 ! evdwij_przed_tri=evdwij
1432 call triple_ssbond_ene(i,j,k,evdwij)
1433 !c if(evdwij_przed_tri.ne.evdwij) then
1434 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1437 !c write(iout,*) "PO TRI", evdwij
1438 !C call the energy function that removes the artifical triple disulfide
1439 !C bond the soubroutine is located in ssMD.F
1441 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1442 'evdw',i,j,evdwij,'tss'
1443 endif!dyn_ss_mask(k)
1447 itypj=iabs(itype(j,1))
1448 if (itypj.eq.ntyp1) cycle
1449 ! if (j.ne.78) cycle
1450 ! dscj_inv=dsc_inv(itypj)
1451 dscj_inv=vbld_inv(j+nres)
1452 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1453 ! 1.0d0/vbld(j+nres) !d
1454 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1455 sig0ij=sigma(itypi,itypj)
1456 chi1=chi(itypi,itypj)
1457 chi2=chi(itypj,itypi)
1464 alf12=0.5D0*(alf1+alf2)
1465 ! For diagnostics only!!!
1478 xj=dmod(xj,boxxsize)
1479 if (xj.lt.0) xj=xj+boxxsize
1480 yj=dmod(yj,boxysize)
1481 if (yj.lt.0) yj=yj+boxysize
1482 zj=dmod(zj,boxzsize)
1483 if (zj.lt.0) zj=zj+boxzsize
1484 ! print *,"tu",xi,yi,zi,xj,yj,zj
1485 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1486 ! this fragment set correct epsilon for lipid phase
1487 if ((zj.gt.bordlipbot) &
1488 .and.(zj.lt.bordliptop)) then
1489 !C the energy transfer exist
1490 if (zj.lt.buflipbot) then
1491 !C what fraction I am in
1493 ((zj-bordlipbot)/lipbufthick)
1494 !C lipbufthick is thickenes of lipid buffore
1495 sslipj=sscalelip(fracinbuf)
1496 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1497 elseif (zj.gt.bufliptop) then
1498 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1499 sslipj=sscalelip(fracinbuf)
1500 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1509 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1510 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1511 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1512 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1513 !------------------------------------------------
1514 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1522 xj=xj_safe+xshift*boxxsize
1523 yj=yj_safe+yshift*boxysize
1524 zj=zj_safe+zshift*boxzsize
1525 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1526 if(dist_temp.lt.dist_init) then
1536 if (subchap.eq.1) then
1545 dxj=dc_norm(1,nres+j)
1546 dyj=dc_norm(2,nres+j)
1547 dzj=dc_norm(3,nres+j)
1548 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1549 ! write (iout,*) "j",j," dc_norm",& !d
1550 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1551 ! write(iout,*)"rrij ",rrij
1552 ! write(iout,*)"xj yj zj ", xj, yj, zj
1553 ! write(iout,*)"xi yi zi ", xi, yi, zi
1554 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1555 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1557 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1558 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1559 ! print *,sss_ele_cut,sss_ele_grad,&
1560 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1561 if (sss_ele_cut.le.0.0) cycle
1562 ! Calculate angle-dependent terms of energy and contributions to their
1566 sig=sig0ij*dsqrt(sigsq)
1567 rij_shift=1.0D0/rij-sig+sig0ij
1568 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1570 ! for diagnostics; uncomment
1571 ! rij_shift=1.2*sig0ij
1572 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1573 if (rij_shift.le.0.0D0) then
1575 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1576 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1577 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1581 !---------------------------------------------------------------
1582 rij_shift=1.0D0/rij_shift
1583 fac=rij_shift**expon
1585 e1=fac*fac*aa!(itypi,itypj)
1586 e2=fac*bb!(itypi,itypj)
1587 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1588 eps2der=evdwij*eps3rt
1589 eps3der=evdwij*eps2rt
1590 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1591 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1592 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1593 evdwij=evdwij*eps2rt*eps3rt
1594 evdw=evdw+evdwij*sss_ele_cut
1596 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1597 epsi=bb**2/aa!(itypi,itypj)
1598 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1599 restyp(itypi,1),i,restyp(itypj,1),j, &
1600 epsi,sigm,chi1,chi2,chip1,chip2, &
1601 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1602 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1606 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1607 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1608 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1609 ! if (energy_dec) write (iout,*) &
1612 ! Calculate gradient components.
1613 e1=e1*eps1*eps2rt**2*eps3rt**2
1614 fac=-expon*(e1+evdwij)*rij_shift
1617 ! print *,'before fac',fac,rij,evdwij
1618 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1619 /sigma(itypi,itypj)*rij
1620 ! print *,'grad part scale',fac, &
1621 ! evdwij*sss_ele_grad/sss_ele_cut &
1622 ! /sigma(itypi,itypj)*rij
1624 ! Calculate the radial part of the gradient
1628 !C Calculate the radial part of the gradient
1629 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1630 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1631 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1632 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1633 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1634 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1636 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1637 ! Calculate angular part of the gradient.
1643 ! write (iout,*) "Number of loop steps in EGB:",ind
1644 !ccc energy_dec=.false.
1647 !-----------------------------------------------------------------------------
1648 subroutine egbv(evdw)
1650 ! This subroutine calculates the interaction energy of nonbonded side chains
1651 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1655 ! implicit real*8 (a-h,o-z)
1656 ! include 'DIMENSIONS'
1657 ! include 'COMMON.GEO'
1658 ! include 'COMMON.VAR'
1659 ! include 'COMMON.LOCAL'
1660 ! include 'COMMON.CHAIN'
1661 ! include 'COMMON.DERIV'
1662 ! include 'COMMON.NAMES'
1663 ! include 'COMMON.INTERACT'
1664 ! include 'COMMON.IOUNITS'
1665 ! include 'COMMON.CALC'
1667 !el integer :: icall
1668 !el common /srutu/ icall
1671 integer :: iint,itypi,itypi1,itypj
1672 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1673 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1675 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1678 ! if (icall.eq.0) lprn=.true.
1680 do i=iatsc_s,iatsc_e
1681 itypi=iabs(itype(i,1))
1682 if (itypi.eq.ntyp1) cycle
1683 itypi1=iabs(itype(i+1,1))
1687 dxi=dc_norm(1,nres+i)
1688 dyi=dc_norm(2,nres+i)
1689 dzi=dc_norm(3,nres+i)
1690 ! dsci_inv=dsc_inv(itypi)
1691 dsci_inv=vbld_inv(i+nres)
1693 ! Calculate SC interaction energy.
1695 do iint=1,nint_gr(i)
1696 do j=istart(i,iint),iend(i,iint)
1698 itypj=iabs(itype(j,1))
1699 if (itypj.eq.ntyp1) cycle
1700 ! dscj_inv=dsc_inv(itypj)
1701 dscj_inv=vbld_inv(j+nres)
1702 sig0ij=sigma(itypi,itypj)
1703 r0ij=r0(itypi,itypj)
1704 chi1=chi(itypi,itypj)
1705 chi2=chi(itypj,itypi)
1712 alf12=0.5D0*(alf1+alf2)
1713 ! For diagnostics only!!!
1726 dxj=dc_norm(1,nres+j)
1727 dyj=dc_norm(2,nres+j)
1728 dzj=dc_norm(3,nres+j)
1729 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1731 ! Calculate angle-dependent terms of energy and contributions to their
1735 sig=sig0ij*dsqrt(sigsq)
1736 rij_shift=1.0D0/rij-sig+r0ij
1737 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1738 if (rij_shift.le.0.0D0) then
1743 !---------------------------------------------------------------
1744 rij_shift=1.0D0/rij_shift
1745 fac=rij_shift**expon
1746 e1=fac*fac*aa_aq(itypi,itypj)
1747 e2=fac*bb_aq(itypi,itypj)
1748 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1749 eps2der=evdwij*eps3rt
1750 eps3der=evdwij*eps2rt
1751 fac_augm=rrij**expon
1752 e_augm=augm(itypi,itypj)*fac_augm
1753 evdwij=evdwij*eps2rt*eps3rt
1754 evdw=evdw+evdwij+e_augm
1756 sigm=dabs(aa_aq(itypi,itypj)/&
1757 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1758 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1759 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1760 restyp(itypi,1),i,restyp(itypj,1),j,&
1761 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1762 chi1,chi2,chip1,chip2,&
1763 eps1,eps2rt**2,eps3rt**2,&
1764 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1767 ! Calculate gradient components.
1768 e1=e1*eps1*eps2rt**2*eps3rt**2
1769 fac=-expon*(e1+evdwij)*rij_shift
1771 fac=rij*fac-2*expon*rrij*e_augm
1772 ! Calculate the radial part of the gradient
1776 ! Calculate angular part of the gradient.
1782 !-----------------------------------------------------------------------------
1783 !el subroutine sc_angular in module geometry
1784 !-----------------------------------------------------------------------------
1785 subroutine e_softsphere(evdw)
1787 ! This subroutine calculates the interaction energy of nonbonded side chains
1788 ! assuming the LJ potential of interaction.
1790 ! implicit real*8 (a-h,o-z)
1791 ! include 'DIMENSIONS'
1792 real(kind=8),parameter :: accur=1.0d-10
1793 ! include 'COMMON.GEO'
1794 ! include 'COMMON.VAR'
1795 ! include 'COMMON.LOCAL'
1796 ! include 'COMMON.CHAIN'
1797 ! include 'COMMON.DERIV'
1798 ! include 'COMMON.INTERACT'
1799 ! include 'COMMON.TORSION'
1800 ! include 'COMMON.SBRIDGE'
1801 ! include 'COMMON.NAMES'
1802 ! include 'COMMON.IOUNITS'
1803 ! include 'COMMON.CONTACTS'
1804 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1805 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1807 integer :: i,iint,j,itypi,itypi1,itypj,k
1808 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1812 do i=iatsc_s,iatsc_e
1813 itypi=iabs(itype(i,1))
1814 if (itypi.eq.ntyp1) cycle
1815 itypi1=iabs(itype(i+1,1))
1820 ! Calculate SC interaction energy.
1822 do iint=1,nint_gr(i)
1823 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1824 !d & 'iend=',iend(i,iint)
1825 do j=istart(i,iint),iend(i,iint)
1826 itypj=iabs(itype(j,1))
1827 if (itypj.eq.ntyp1) cycle
1831 rij=xj*xj+yj*yj+zj*zj
1832 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1833 r0ij=r0(itypi,itypj)
1835 ! print *,i,j,r0ij,dsqrt(rij)
1836 if (rij.lt.r0ijsq) then
1837 evdwij=0.25d0*(rij-r0ijsq)**2
1845 ! Calculate the components of the gradient in DC and X
1851 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1852 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1853 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1854 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1858 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1865 end subroutine e_softsphere
1866 !-----------------------------------------------------------------------------
1867 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1869 ! Soft-sphere potential of p-p interaction
1871 ! implicit real*8 (a-h,o-z)
1872 ! include 'DIMENSIONS'
1873 ! include 'COMMON.CONTROL'
1874 ! include 'COMMON.IOUNITS'
1875 ! include 'COMMON.GEO'
1876 ! include 'COMMON.VAR'
1877 ! include 'COMMON.LOCAL'
1878 ! include 'COMMON.CHAIN'
1879 ! include 'COMMON.DERIV'
1880 ! include 'COMMON.INTERACT'
1881 ! include 'COMMON.CONTACTS'
1882 ! include 'COMMON.TORSION'
1883 ! include 'COMMON.VECTORS'
1884 ! include 'COMMON.FFIELD'
1885 real(kind=8),dimension(3) :: ggg
1886 !d write(iout,*) 'In EELEC_soft_sphere'
1888 integer :: i,j,k,num_conti,iteli,itelj
1889 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
1890 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
1891 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
1899 do i=iatel_s,iatel_e
1900 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
1904 xmedi=c(1,i)+0.5d0*dxi
1905 ymedi=c(2,i)+0.5d0*dyi
1906 zmedi=c(3,i)+0.5d0*dzi
1908 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1909 do j=ielstart(i),ielend(i)
1910 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
1914 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1915 r0ij=rpp(iteli,itelj)
1920 xj=c(1,j)+0.5D0*dxj-xmedi
1921 yj=c(2,j)+0.5D0*dyj-ymedi
1922 zj=c(3,j)+0.5D0*dzj-zmedi
1923 rij=xj*xj+yj*yj+zj*zj
1924 if (rij.lt.r0ijsq) then
1925 evdw1ij=0.25d0*(rij-r0ijsq)**2
1933 ! Calculate contributions to the Cartesian gradient.
1939 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1940 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1943 ! Loop over residues i+1 thru j-1.
1947 !grad gelc(l,k)=gelc(l,k)+ggg(l)
1952 !grad do i=nnt,nct-1
1954 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1956 !grad do j=i+1,nct-1
1958 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
1963 end subroutine eelec_soft_sphere
1964 !-----------------------------------------------------------------------------
1965 subroutine vec_and_deriv
1966 ! implicit real*8 (a-h,o-z)
1967 ! include 'DIMENSIONS'
1971 ! include 'COMMON.IOUNITS'
1972 ! include 'COMMON.GEO'
1973 ! include 'COMMON.VAR'
1974 ! include 'COMMON.LOCAL'
1975 ! include 'COMMON.CHAIN'
1976 ! include 'COMMON.VECTORS'
1977 ! include 'COMMON.SETUP'
1978 ! include 'COMMON.TIME1'
1979 real(kind=8),dimension(3,3,2) :: uyder,uzder
1980 real(kind=8),dimension(2) :: vbld_inv_temp
1981 ! Compute the local reference systems. For reference system (i), the
1982 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
1983 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1986 real(kind=8) :: facy,fac,costh
1989 do i=ivec_start,ivec_end
1993 if (i.eq.nres-1) then
1994 ! Case of the last full residue
1995 ! Compute the Z-axis
1996 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1997 costh=dcos(pi-theta(nres))
1998 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2002 ! Compute the derivatives of uz
2004 uzder(2,1,1)=-dc_norm(3,i-1)
2005 uzder(3,1,1)= dc_norm(2,i-1)
2006 uzder(1,2,1)= dc_norm(3,i-1)
2008 uzder(3,2,1)=-dc_norm(1,i-1)
2009 uzder(1,3,1)=-dc_norm(2,i-1)
2010 uzder(2,3,1)= dc_norm(1,i-1)
2013 uzder(2,1,2)= dc_norm(3,i)
2014 uzder(3,1,2)=-dc_norm(2,i)
2015 uzder(1,2,2)=-dc_norm(3,i)
2017 uzder(3,2,2)= dc_norm(1,i)
2018 uzder(1,3,2)= dc_norm(2,i)
2019 uzder(2,3,2)=-dc_norm(1,i)
2021 ! Compute the Y-axis
2024 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2026 ! Compute the derivatives of uy
2029 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2030 -dc_norm(k,i)*dc_norm(j,i-1)
2031 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2033 uyder(j,j,1)=uyder(j,j,1)-costh
2034 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2039 uygrad(l,k,j,i)=uyder(l,k,j)
2040 uzgrad(l,k,j,i)=uzder(l,k,j)
2044 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2045 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2046 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2047 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2050 ! Compute the Z-axis
2051 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2052 costh=dcos(pi-theta(i+2))
2053 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2057 ! Compute the derivatives of uz
2059 uzder(2,1,1)=-dc_norm(3,i+1)
2060 uzder(3,1,1)= dc_norm(2,i+1)
2061 uzder(1,2,1)= dc_norm(3,i+1)
2063 uzder(3,2,1)=-dc_norm(1,i+1)
2064 uzder(1,3,1)=-dc_norm(2,i+1)
2065 uzder(2,3,1)= dc_norm(1,i+1)
2068 uzder(2,1,2)= dc_norm(3,i)
2069 uzder(3,1,2)=-dc_norm(2,i)
2070 uzder(1,2,2)=-dc_norm(3,i)
2072 uzder(3,2,2)= dc_norm(1,i)
2073 uzder(1,3,2)= dc_norm(2,i)
2074 uzder(2,3,2)=-dc_norm(1,i)
2076 ! Compute the Y-axis
2079 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2081 ! Compute the derivatives of uy
2084 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2085 -dc_norm(k,i)*dc_norm(j,i+1)
2086 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2088 uyder(j,j,1)=uyder(j,j,1)-costh
2089 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2094 uygrad(l,k,j,i)=uyder(l,k,j)
2095 uzgrad(l,k,j,i)=uzder(l,k,j)
2099 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2100 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2101 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2102 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2106 vbld_inv_temp(1)=vbld_inv(i+1)
2107 if (i.lt.nres-1) then
2108 vbld_inv_temp(2)=vbld_inv(i+2)
2110 vbld_inv_temp(2)=vbld_inv(i)
2115 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2116 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2121 #if defined(PARVEC) && defined(MPI)
2122 if (nfgtasks1.gt.1) then
2124 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2125 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2126 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2127 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2128 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2130 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2131 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2133 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2134 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2135 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2136 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2137 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2138 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2139 time_gather=time_gather+MPI_Wtime()-time00
2141 ! if (fg_rank.eq.0) then
2142 ! write (iout,*) "Arrays UY and UZ"
2144 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2150 end subroutine vec_and_deriv
2151 !-----------------------------------------------------------------------------
2152 subroutine check_vecgrad
2153 ! implicit real*8 (a-h,o-z)
2154 ! include 'DIMENSIONS'
2155 ! include 'COMMON.IOUNITS'
2156 ! include 'COMMON.GEO'
2157 ! include 'COMMON.VAR'
2158 ! include 'COMMON.LOCAL'
2159 ! include 'COMMON.CHAIN'
2160 ! include 'COMMON.VECTORS'
2161 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2162 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2163 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2164 real(kind=8),dimension(3) :: erij
2165 real(kind=8) :: delta=1.0d-7
2171 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2172 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2173 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2174 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2175 !d & (dc_norm(if90,i),if90=1,3)
2176 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2177 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2178 !d write(iout,'(a)')
2184 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2185 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2198 !d write (iout,*) 'i=',i
2200 erij(k)=dc_norm(k,i)
2204 dc_norm(k,i)=erij(k)
2206 dc_norm(j,i)=dc_norm(j,i)+delta
2207 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2209 ! dc_norm(k,i)=dc_norm(k,i)/fac
2211 ! write (iout,*) (dc_norm(k,i),k=1,3)
2212 ! write (iout,*) (erij(k),k=1,3)
2215 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2216 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2217 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2218 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2220 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2221 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2222 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2225 dc_norm(k,i)=erij(k)
2228 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2229 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2230 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2231 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2232 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2233 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2234 !d write (iout,'(a)')
2238 end subroutine check_vecgrad
2239 !-----------------------------------------------------------------------------
2240 subroutine set_matrices
2241 ! implicit real*8 (a-h,o-z)
2242 ! include 'DIMENSIONS'
2245 ! include "COMMON.SETUP"
2247 integer :: status(MPI_STATUS_SIZE)
2249 ! include 'COMMON.IOUNITS'
2250 ! include 'COMMON.GEO'
2251 ! include 'COMMON.VAR'
2252 ! include 'COMMON.LOCAL'
2253 ! include 'COMMON.CHAIN'
2254 ! include 'COMMON.DERIV'
2255 ! include 'COMMON.INTERACT'
2256 ! include 'COMMON.CONTACTS'
2257 ! include 'COMMON.TORSION'
2258 ! include 'COMMON.VECTORS'
2259 ! include 'COMMON.FFIELD'
2260 real(kind=8) :: auxvec(2),auxmat(2,2)
2261 integer :: i,iti1,iti,k,l
2262 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2263 ! print *,"in set matrices"
2265 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2266 ! to calculate the el-loc multibody terms of various order.
2270 do i=ivec_start+2,ivec_end+2
2275 if (i .lt. nres+1) then
2312 if (i .gt. 3 .and. i .lt. nres+1) then
2313 obrot_der(1,i-2)=-sin1
2314 obrot_der(2,i-2)= cos1
2315 Ugder(1,1,i-2)= sin1
2316 Ugder(1,2,i-2)=-cos1
2317 Ugder(2,1,i-2)=-cos1
2318 Ugder(2,2,i-2)=-sin1
2321 obrot2_der(1,i-2)=-dwasin2
2322 obrot2_der(2,i-2)= dwacos2
2323 Ug2der(1,1,i-2)= dwasin2
2324 Ug2der(1,2,i-2)=-dwacos2
2325 Ug2der(2,1,i-2)=-dwacos2
2326 Ug2der(2,2,i-2)=-dwasin2
2328 obrot_der(1,i-2)=0.0d0
2329 obrot_der(2,i-2)=0.0d0
2330 Ugder(1,1,i-2)=0.0d0
2331 Ugder(1,2,i-2)=0.0d0
2332 Ugder(2,1,i-2)=0.0d0
2333 Ugder(2,2,i-2)=0.0d0
2334 obrot2_der(1,i-2)=0.0d0
2335 obrot2_der(2,i-2)=0.0d0
2336 Ug2der(1,1,i-2)=0.0d0
2337 Ug2der(1,2,i-2)=0.0d0
2338 Ug2der(2,1,i-2)=0.0d0
2339 Ug2der(2,2,i-2)=0.0d0
2341 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2342 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2343 iti = itortyp(itype(i-2,1))
2347 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2348 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2349 iti1 = itortyp(itype(i-1,1))
2353 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2354 !d write (iout,*) '*******i',i,' iti1',iti
2355 !d write (iout,*) 'b1',b1(:,iti)
2356 !d write (iout,*) 'b2',b2(:,iti)
2357 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2358 ! if (i .gt. iatel_s+2) then
2359 if (i .gt. nnt+2) then
2360 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2361 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2362 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2364 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2365 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2366 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2367 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2368 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2379 DtUg2(l,k,i-2)=0.0d0
2383 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2384 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2386 muder(k,i-2)=Ub2der(k,i-2)
2388 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2389 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2390 if (itype(i-1,1).le.ntyp) then
2391 iti1 = itortyp(itype(i-1,1))
2399 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2401 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2402 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2403 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2404 !d write (iout,*) 'mu1',mu1(:,i-2)
2405 !d write (iout,*) 'mu2',mu2(:,i-2)
2406 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2408 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2409 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2410 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2411 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2412 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2413 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2414 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2415 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2416 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2417 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2418 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2419 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2420 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2421 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2422 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2425 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2426 ! The order of matrices is from left to right.
2427 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2429 ! do i=max0(ivec_start,2),ivec_end
2431 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2432 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2433 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2434 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2435 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2436 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2437 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2438 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2441 #if defined(MPI) && defined(PARMAT)
2443 ! if (fg_rank.eq.0) then
2444 write (iout,*) "Arrays UG and UGDER before GATHER"
2446 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2447 ((ug(l,k,i),l=1,2),k=1,2),&
2448 ((ugder(l,k,i),l=1,2),k=1,2)
2450 write (iout,*) "Arrays UG2 and UG2DER"
2452 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2453 ((ug2(l,k,i),l=1,2),k=1,2),&
2454 ((ug2der(l,k,i),l=1,2),k=1,2)
2456 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2458 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2459 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2460 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2462 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2464 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2465 costab(i),sintab(i),costab2(i),sintab2(i)
2467 write (iout,*) "Array MUDER"
2469 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2473 if (nfgtasks.gt.1) then
2475 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2476 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2477 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2479 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2480 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2482 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2483 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2485 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2486 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2488 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2489 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2491 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2492 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2494 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2495 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2497 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2498 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2499 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2500 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2501 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2502 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2503 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2504 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2505 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2506 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2507 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2508 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2509 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2511 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2512 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2514 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2515 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2517 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2518 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2520 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2521 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2523 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2524 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2526 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2527 ivec_count(fg_rank1),&
2528 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2530 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2531 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2533 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2534 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2536 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2537 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2539 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2540 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2542 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2543 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2545 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2546 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2548 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2549 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2551 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2552 ivec_count(fg_rank1),&
2553 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2555 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2556 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2558 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2559 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2561 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2562 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2564 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2565 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2567 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2568 ivec_count(fg_rank1),&
2569 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2571 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2572 ivec_count(fg_rank1),&
2573 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2575 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2576 ivec_count(fg_rank1),&
2577 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2578 MPI_MAT2,FG_COMM1,IERR)
2579 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2580 ivec_count(fg_rank1),&
2581 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2582 MPI_MAT2,FG_COMM1,IERR)
2585 ! Passes matrix info through the ring
2588 if (irecv.lt.0) irecv=nfgtasks1-1
2591 if (inext.ge.nfgtasks1) inext=0
2593 ! write (iout,*) "isend",isend," irecv",irecv
2595 lensend=lentyp(isend)
2596 lenrecv=lentyp(irecv)
2597 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2598 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2599 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2600 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2601 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2602 ! write (iout,*) "Gather ROTAT1"
2604 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2605 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2606 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2607 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2608 ! write (iout,*) "Gather ROTAT2"
2610 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2611 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2612 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2613 iprev,4400+irecv,FG_COMM,status,IERR)
2614 ! write (iout,*) "Gather ROTAT_OLD"
2616 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2617 MPI_PRECOMP11(lensend),inext,5500+isend,&
2618 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2619 iprev,5500+irecv,FG_COMM,status,IERR)
2620 ! write (iout,*) "Gather PRECOMP11"
2622 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2623 MPI_PRECOMP12(lensend),inext,6600+isend,&
2624 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2625 iprev,6600+irecv,FG_COMM,status,IERR)
2626 ! write (iout,*) "Gather PRECOMP12"
2628 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2630 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2631 MPI_ROTAT2(lensend),inext,7700+isend,&
2632 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2633 iprev,7700+irecv,FG_COMM,status,IERR)
2634 ! write (iout,*) "Gather PRECOMP21"
2636 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2637 MPI_PRECOMP22(lensend),inext,8800+isend,&
2638 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2639 iprev,8800+irecv,FG_COMM,status,IERR)
2640 ! write (iout,*) "Gather PRECOMP22"
2642 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2643 MPI_PRECOMP23(lensend),inext,9900+isend,&
2644 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2645 MPI_PRECOMP23(lenrecv),&
2646 iprev,9900+irecv,FG_COMM,status,IERR)
2647 ! write (iout,*) "Gather PRECOMP23"
2652 if (irecv.lt.0) irecv=nfgtasks1-1
2655 time_gather=time_gather+MPI_Wtime()-time00
2658 ! if (fg_rank.eq.0) then
2659 write (iout,*) "Arrays UG and UGDER"
2661 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2662 ((ug(l,k,i),l=1,2),k=1,2),&
2663 ((ugder(l,k,i),l=1,2),k=1,2)
2665 write (iout,*) "Arrays UG2 and UG2DER"
2667 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2668 ((ug2(l,k,i),l=1,2),k=1,2),&
2669 ((ug2der(l,k,i),l=1,2),k=1,2)
2671 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2673 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2674 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2675 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2677 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2679 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2680 costab(i),sintab(i),costab2(i),sintab2(i)
2682 write (iout,*) "Array MUDER"
2684 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2690 !d iti = itortyp(itype(i,1))
2693 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2694 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2698 end subroutine set_matrices
2699 !-----------------------------------------------------------------------------
2700 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2702 ! This subroutine calculates the average interaction energy and its gradient
2703 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2704 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2705 ! The potential depends both on the distance of peptide-group centers and on
2706 ! the orientation of the CA-CA virtual bonds.
2709 ! implicit real*8 (a-h,o-z)
2713 ! include 'DIMENSIONS'
2714 ! include 'COMMON.CONTROL'
2715 ! include 'COMMON.SETUP'
2716 ! include 'COMMON.IOUNITS'
2717 ! include 'COMMON.GEO'
2718 ! include 'COMMON.VAR'
2719 ! include 'COMMON.LOCAL'
2720 ! include 'COMMON.CHAIN'
2721 ! include 'COMMON.DERIV'
2722 ! include 'COMMON.INTERACT'
2723 ! include 'COMMON.CONTACTS'
2724 ! include 'COMMON.TORSION'
2725 ! include 'COMMON.VECTORS'
2726 ! include 'COMMON.FFIELD'
2727 ! include 'COMMON.TIME1'
2728 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2729 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2730 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2731 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2732 real(kind=8),dimension(4) :: muij
2733 !el integer :: num_conti,j1,j2
2734 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2735 !el dz_normi,xmedi,ymedi,zmedi
2737 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2738 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2741 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2743 real(kind=8) :: scal_el=1.0d0
2745 real(kind=8) :: scal_el=0.5d0
2748 ! 13-go grudnia roku pamietnego...
2749 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2751 0.0d0,0.0d0,1.0d0/),shape(unmat))
2754 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2755 real(kind=8) :: fac,t_eelecij,fracinbuf
2758 !d write(iout,*) 'In EELEC'
2759 ! print *,"IN EELEC"
2761 !d write(iout,*) 'Type',i
2762 !d write(iout,*) 'B1',B1(:,i)
2763 !d write(iout,*) 'B2',B2(:,i)
2764 !d write(iout,*) 'CC',CC(:,:,i)
2765 !d write(iout,*) 'DD',DD(:,:,i)
2766 !d write(iout,*) 'EE',EE(:,:,i)
2768 !d call check_vecgrad
2783 if (icheckgrad.eq.1) then
2786 ! dc_norm(1,i)=0.0d0
2787 ! dc_norm(2,i)=0.0d0
2788 ! dc_norm(3,i)=0.0d0
2791 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2793 dc_norm(k,i)=dc(k,i)*fac
2795 ! write (iout,*) 'i',i,' fac',fac
2798 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
2800 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2801 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2802 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2803 ! call vec_and_deriv
2807 ! print *, "before set matrices"
2809 ! print *, "after set matrices"
2812 time_mat=time_mat+MPI_Wtime()-time01
2815 ! print *, "after set matrices"
2817 !d write (iout,*) 'i=',i
2819 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2822 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2823 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2836 !d print '(a)','Enter EELEC'
2837 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2838 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2839 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2841 gel_loc_loc(i)=0.0d0
2846 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2848 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2852 ! print *,"before iturn3 loop"
2853 do i=iturn3_start,iturn3_end
2854 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
2855 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
2859 dx_normi=dc_norm(1,i)
2860 dy_normi=dc_norm(2,i)
2861 dz_normi=dc_norm(3,i)
2862 xmedi=c(1,i)+0.5d0*dxi
2863 ymedi=c(2,i)+0.5d0*dyi
2864 zmedi=c(3,i)+0.5d0*dzi
2865 xmedi=dmod(xmedi,boxxsize)
2866 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2867 ymedi=dmod(ymedi,boxysize)
2868 if (ymedi.lt.0) ymedi=ymedi+boxysize
2869 zmedi=dmod(zmedi,boxzsize)
2870 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2872 if ((zmedi.gt.bordlipbot) &
2873 .and.(zmedi.lt.bordliptop)) then
2874 !C the energy transfer exist
2875 if (zmedi.lt.buflipbot) then
2876 !C what fraction I am in
2878 ((zmedi-bordlipbot)/lipbufthick)
2879 !C lipbufthick is thickenes of lipid buffore
2880 sslipi=sscalelip(fracinbuf)
2881 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2882 elseif (zmedi.gt.bufliptop) then
2883 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2884 sslipi=sscalelip(fracinbuf)
2885 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2894 ! print *,i,sslipi,ssgradlipi
2895 call eelecij(i,i+2,ees,evdw1,eel_loc)
2896 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2897 num_cont_hb(i)=num_conti
2899 do i=iturn4_start,iturn4_end
2900 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
2901 .or. itype(i+3,1).eq.ntyp1 &
2902 .or. itype(i+4,1).eq.ntyp1) cycle
2906 dx_normi=dc_norm(1,i)
2907 dy_normi=dc_norm(2,i)
2908 dz_normi=dc_norm(3,i)
2909 xmedi=c(1,i)+0.5d0*dxi
2910 ymedi=c(2,i)+0.5d0*dyi
2911 zmedi=c(3,i)+0.5d0*dzi
2912 xmedi=dmod(xmedi,boxxsize)
2913 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2914 ymedi=dmod(ymedi,boxysize)
2915 if (ymedi.lt.0) ymedi=ymedi+boxysize
2916 zmedi=dmod(zmedi,boxzsize)
2917 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2918 if ((zmedi.gt.bordlipbot) &
2919 .and.(zmedi.lt.bordliptop)) then
2920 !C the energy transfer exist
2921 if (zmedi.lt.buflipbot) then
2922 !C what fraction I am in
2924 ((zmedi-bordlipbot)/lipbufthick)
2925 !C lipbufthick is thickenes of lipid buffore
2926 sslipi=sscalelip(fracinbuf)
2927 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2928 elseif (zmedi.gt.bufliptop) then
2929 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2930 sslipi=sscalelip(fracinbuf)
2931 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2941 num_conti=num_cont_hb(i)
2942 call eelecij(i,i+3,ees,evdw1,eel_loc)
2943 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
2944 call eturn4(i,eello_turn4)
2945 num_cont_hb(i)=num_conti
2948 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2950 do i=iatel_s,iatel_e
2951 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2955 dx_normi=dc_norm(1,i)
2956 dy_normi=dc_norm(2,i)
2957 dz_normi=dc_norm(3,i)
2958 xmedi=c(1,i)+0.5d0*dxi
2959 ymedi=c(2,i)+0.5d0*dyi
2960 zmedi=c(3,i)+0.5d0*dzi
2961 xmedi=dmod(xmedi,boxxsize)
2962 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2963 ymedi=dmod(ymedi,boxysize)
2964 if (ymedi.lt.0) ymedi=ymedi+boxysize
2965 zmedi=dmod(zmedi,boxzsize)
2966 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2967 if ((zmedi.gt.bordlipbot) &
2968 .and.(zmedi.lt.bordliptop)) then
2969 !C the energy transfer exist
2970 if (zmedi.lt.buflipbot) then
2971 !C what fraction I am in
2973 ((zmedi-bordlipbot)/lipbufthick)
2974 !C lipbufthick is thickenes of lipid buffore
2975 sslipi=sscalelip(fracinbuf)
2976 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2977 elseif (zmedi.gt.bufliptop) then
2978 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2979 sslipi=sscalelip(fracinbuf)
2980 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
2990 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2991 num_conti=num_cont_hb(i)
2992 do j=ielstart(i),ielend(i)
2993 ! write (iout,*) i,j,itype(i,1),itype(j,1)
2994 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
2995 call eelecij(i,j,ees,evdw1,eel_loc)
2997 num_cont_hb(i)=num_conti
2999 ! write (iout,*) "Number of loop steps in EELEC:",ind
3001 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3002 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3004 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3005 !cc eel_loc=eel_loc+eello_turn3
3006 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3008 end subroutine eelec
3009 !-----------------------------------------------------------------------------
3010 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3013 ! implicit real*8 (a-h,o-z)
3014 ! include 'DIMENSIONS'
3018 ! include 'COMMON.CONTROL'
3019 ! include 'COMMON.IOUNITS'
3020 ! include 'COMMON.GEO'
3021 ! include 'COMMON.VAR'
3022 ! include 'COMMON.LOCAL'
3023 ! include 'COMMON.CHAIN'
3024 ! include 'COMMON.DERIV'
3025 ! include 'COMMON.INTERACT'
3026 ! include 'COMMON.CONTACTS'
3027 ! include 'COMMON.TORSION'
3028 ! include 'COMMON.VECTORS'
3029 ! include 'COMMON.FFIELD'
3030 ! include 'COMMON.TIME1'
3031 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3032 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3033 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3034 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3035 real(kind=8),dimension(4) :: muij
3036 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3037 dist_temp, dist_init,rlocshield,fracinbuf
3038 integer xshift,yshift,zshift,ilist,iresshield
3039 !el integer :: num_conti,j1,j2
3040 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3041 !el dz_normi,xmedi,ymedi,zmedi
3043 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3044 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3047 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3049 real(kind=8) :: scal_el=1.0d0
3051 real(kind=8) :: scal_el=0.5d0
3054 ! 13-go grudnia roku pamietnego...
3055 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3057 0.0d0,0.0d0,1.0d0/),shape(unmat))
3058 ! integer :: maxconts=nres/4
3060 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3061 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3062 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3063 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3064 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3065 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3066 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3067 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3068 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3069 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3070 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3072 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3073 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3075 ! time00=MPI_Wtime()
3076 !d write (iout,*) "eelecij",i,j
3080 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3081 aaa=app(iteli,itelj)
3082 bbb=bpp(iteli,itelj)
3083 ael6i=ael6(iteli,itelj)
3084 ael3i=ael3(iteli,itelj)
3088 dx_normj=dc_norm(1,j)
3089 dy_normj=dc_norm(2,j)
3090 dz_normj=dc_norm(3,j)
3091 ! xj=c(1,j)+0.5D0*dxj-xmedi
3092 ! yj=c(2,j)+0.5D0*dyj-ymedi
3093 ! zj=c(3,j)+0.5D0*dzj-zmedi
3098 if (xj.lt.0) xj=xj+boxxsize
3100 if (yj.lt.0) yj=yj+boxysize
3102 if (zj.lt.0) zj=zj+boxzsize
3103 if ((zj.gt.bordlipbot) &
3104 .and.(zj.lt.bordliptop)) then
3105 !C the energy transfer exist
3106 if (zj.lt.buflipbot) then
3107 !C what fraction I am in
3109 ((zj-bordlipbot)/lipbufthick)
3110 !C lipbufthick is thickenes of lipid buffore
3111 sslipj=sscalelip(fracinbuf)
3112 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3113 elseif (zj.gt.bufliptop) then
3114 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3115 sslipj=sscalelip(fracinbuf)
3116 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3127 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3134 xj=xj_safe+xshift*boxxsize
3135 yj=yj_safe+yshift*boxysize
3136 zj=zj_safe+zshift*boxzsize
3137 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3138 if(dist_temp.lt.dist_init) then
3148 if (isubchap.eq.1) then
3159 rij=xj*xj+yj*yj+zj*zj
3162 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3163 sss_ele_cut=sscale_ele(rij)
3164 sss_ele_grad=sscagrad_ele(rij)
3166 ! sss_ele_grad=0.0d0
3167 ! print *,sss_ele_cut,sss_ele_grad,&
3168 ! (rij),r_cut_ele,rlamb_ele
3169 ! if (sss_ele_cut.le.0.0) go to 128
3174 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3175 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3176 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3177 fac=cosa-3.0D0*cosb*cosg
3179 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3180 if (j.eq.i+2) ev1=scal_el*ev1
3185 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3188 if (shield_mode.gt.0) then
3189 !C fac_shield(i)=0.4
3190 !C fac_shield(j)=0.6
3191 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3192 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3194 ees=ees+eesij*sss_ele_cut
3195 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3196 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3202 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3203 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3206 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3207 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3208 ! ees=ees+eesij*sss_ele_cut
3209 evdw1=evdw1+evdwij*sss_ele_cut &
3210 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3211 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3212 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3213 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3214 !d & xmedi,ymedi,zmedi,xj,yj,zj
3216 if (energy_dec) then
3217 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3218 ! 'evdw1',i,j,evdwij,&
3219 ! iteli,itelj,aaa,evdw1
3220 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3221 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3224 ! Calculate contributions to the Cartesian gradient.
3227 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3228 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3229 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3230 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3236 ! Radial derivatives. First process both termini of the fragment (i,j)
3238 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3239 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3240 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3241 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3242 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3243 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3245 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3246 (shield_mode.gt.0)) then
3248 do ilist=1,ishield_list(i)
3249 iresshield=shield_list(ilist,i)
3251 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3253 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3255 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3257 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3260 do ilist=1,ishield_list(j)
3261 iresshield=shield_list(ilist,j)
3263 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3265 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3267 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3269 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3273 gshieldc(k,i)=gshieldc(k,i)+ &
3274 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3277 gshieldc(k,j)=gshieldc(k,j)+ &
3278 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3281 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3282 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3285 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3286 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3294 ! ghalf=0.5D0*ggg(k)
3295 ! gelc(k,i)=gelc(k,i)+ghalf
3296 ! gelc(k,j)=gelc(k,j)+ghalf
3298 ! 9/28/08 AL Gradient compotents will be summed only at the end
3300 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3301 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3303 gelc_long(3,j)=gelc_long(3,j)+ &
3304 ssgradlipj*eesij/2.0d0*lipscale**2&
3307 gelc_long(3,i)=gelc_long(3,i)+ &
3308 ssgradlipi*eesij/2.0d0*lipscale**2&
3313 ! Loop over residues i+1 thru j-1.
3317 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3320 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3321 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3322 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3323 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3324 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3325 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3328 ! ghalf=0.5D0*ggg(k)
3329 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3330 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3332 ! 9/28/08 AL Gradient compotents will be summed only at the end
3334 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3335 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3338 !C Lipidic part for scaling weight
3339 gvdwpp(3,j)=gvdwpp(3,j)+ &
3340 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3341 gvdwpp(3,i)=gvdwpp(3,i)+ &
3342 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3343 !! Loop over residues i+1 thru j-1.
3347 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3351 facvdw=(ev1+evdwij)*sss_ele_cut &
3352 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3354 facel=(el1+eesij)*sss_ele_cut
3356 fac=-3*rrmij*(facvdw+facvdw+facel)
3361 ! Radial derivatives. First process both termini of the fragment (i,j)
3363 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3364 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3365 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3367 ! ghalf=0.5D0*ggg(k)
3368 ! gelc(k,i)=gelc(k,i)+ghalf
3369 ! gelc(k,j)=gelc(k,j)+ghalf
3371 ! 9/28/08 AL Gradient compotents will be summed only at the end
3373 gelc_long(k,j)=gelc(k,j)+ggg(k)
3374 gelc_long(k,i)=gelc(k,i)-ggg(k)
3377 ! Loop over residues i+1 thru j-1.
3381 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3384 ! 9/28/08 AL Gradient compotents will be summed only at the end
3386 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3388 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3390 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3393 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3394 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3396 gvdwpp(3,j)=gvdwpp(3,j)+ &
3397 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3398 gvdwpp(3,i)=gvdwpp(3,i)+ &
3399 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3405 ecosa=2.0D0*fac3*fac1+fac4
3408 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3409 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3411 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3412 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3414 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3415 !d & (dcosg(k),k=1,3)
3417 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3418 *fac_shield(i)**2*fac_shield(j)**2 &
3419 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3423 ! ghalf=0.5D0*ggg(k)
3424 ! gelc(k,i)=gelc(k,i)+ghalf
3425 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3426 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3427 ! gelc(k,j)=gelc(k,j)+ghalf
3428 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3429 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3433 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3437 gelc(k,i)=gelc(k,i) &
3438 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3439 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3441 *fac_shield(i)**2*fac_shield(j)**2 &
3442 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3444 gelc(k,j)=gelc(k,j) &
3445 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3446 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3448 *fac_shield(i)**2*fac_shield(j)**2 &
3449 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3451 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3452 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3455 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3456 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3457 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3459 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3460 ! energy of a peptide unit is assumed in the form of a second-order
3461 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3462 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3463 ! are computed for EVERY pair of non-contiguous peptide groups.
3465 if (j.lt.nres-1) then
3476 muij(kkk)=mu(k,i)*mu(l,j)
3479 !d write (iout,*) 'EELEC: i',i,' j',j
3480 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3481 !d write(iout,*) 'muij',muij
3482 ury=scalar(uy(1,i),erij)
3483 urz=scalar(uz(1,i),erij)
3484 vry=scalar(uy(1,j),erij)
3485 vrz=scalar(uz(1,j),erij)
3486 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3487 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3488 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3489 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3490 fac=dsqrt(-ael6i)*r3ij
3495 !d write (iout,'(4i5,4f10.5)')
3496 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3497 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3498 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3499 !d & uy(:,j),uz(:,j)
3500 !d write (iout,'(4f10.5)')
3501 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3502 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3503 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3504 !d write (iout,'(9f10.5/)')
3505 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3506 ! Derivatives of the elements of A in virtual-bond vectors
3507 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3509 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3510 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3511 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3512 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3513 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3514 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3515 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3516 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3517 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3518 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3519 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3520 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3522 ! Compute radial contributions to the gradient
3540 ! Add the contributions coming from er
3543 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3544 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3545 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3546 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3549 ! Derivatives in DC(i)
3550 !grad ghalf1=0.5d0*agg(k,1)
3551 !grad ghalf2=0.5d0*agg(k,2)
3552 !grad ghalf3=0.5d0*agg(k,3)
3553 !grad ghalf4=0.5d0*agg(k,4)
3554 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3555 -3.0d0*uryg(k,2)*vry)!+ghalf1
3556 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3557 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3558 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3559 -3.0d0*urzg(k,2)*vry)!+ghalf3
3560 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3561 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3562 ! Derivatives in DC(i+1)
3563 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3564 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3565 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3566 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3567 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3568 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3569 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3570 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3571 ! Derivatives in DC(j)
3572 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3573 -3.0d0*vryg(k,2)*ury)!+ghalf1
3574 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3575 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3576 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3577 -3.0d0*vryg(k,2)*urz)!+ghalf3
3578 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3579 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3580 ! Derivatives in DC(j+1) or DC(nres-1)
3581 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3582 -3.0d0*vryg(k,3)*ury)
3583 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3584 -3.0d0*vrzg(k,3)*ury)
3585 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3586 -3.0d0*vryg(k,3)*urz)
3587 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3588 -3.0d0*vrzg(k,3)*urz)
3589 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3591 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3604 aggi(k,l)=-aggi(k,l)
3605 aggi1(k,l)=-aggi1(k,l)
3606 aggj(k,l)=-aggj(k,l)
3607 aggj1(k,l)=-aggj1(k,l)
3610 if (j.lt.nres-1) then
3616 aggi(k,l)=-aggi(k,l)
3617 aggi1(k,l)=-aggi1(k,l)
3618 aggj(k,l)=-aggj(k,l)
3619 aggj1(k,l)=-aggj1(k,l)
3630 aggi(k,l)=-aggi(k,l)
3631 aggi1(k,l)=-aggi1(k,l)
3632 aggj(k,l)=-aggj(k,l)
3633 aggj1(k,l)=-aggj1(k,l)
3638 IF (wel_loc.gt.0.0d0) THEN
3639 ! Contribution to the local-electrostatic energy coming from the i-j pair
3640 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3642 if (shield_mode.eq.0) then
3646 eel_loc_ij=eel_loc_ij &
3647 *fac_shield(i)*fac_shield(j) &
3648 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3649 !C Now derivative over eel_loc
3650 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3651 (shield_mode.gt.0)) then
3654 do ilist=1,ishield_list(i)
3655 iresshield=shield_list(ilist,i)
3657 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3660 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3662 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3665 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3669 do ilist=1,ishield_list(j)
3670 iresshield=shield_list(ilist,j)
3672 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3675 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3677 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3680 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3687 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3688 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3690 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3691 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3693 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3694 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3696 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3697 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3704 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3706 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3707 'eelloc',i,j,eel_loc_ij
3708 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3709 ! if (energy_dec) write (iout,*) "muij",muij
3710 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3712 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3713 ! Partial derivatives in virtual-bond dihedral angles gamma
3715 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3716 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3717 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3719 *fac_shield(i)*fac_shield(j) &
3720 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3722 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3723 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3724 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3726 *fac_shield(i)*fac_shield(j) &
3727 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3728 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3730 ! ggg(1)=(agg(1,1)*muij(1)+ &
3731 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3733 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3734 ! ggg(2)=(agg(2,1)*muij(1)+ &
3735 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3737 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3738 ! ggg(3)=(agg(3,1)*muij(1)+ &
3739 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3741 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3747 ggg(l)=(agg(l,1)*muij(1)+ &
3748 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3750 *fac_shield(i)*fac_shield(j) &
3751 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
3752 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3755 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3756 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3757 !grad ghalf=0.5d0*ggg(l)
3758 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3759 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3761 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
3762 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
3763 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3765 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
3766 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
3767 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3771 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3774 ! Remaining derivatives of eello
3776 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3777 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
3779 *fac_shield(i)*fac_shield(j) &
3780 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3782 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3783 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
3784 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
3785 +aggi1(l,4)*muij(4))&
3787 *fac_shield(i)*fac_shield(j) &
3788 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3790 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3791 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
3792 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
3794 *fac_shield(i)*fac_shield(j) &
3795 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3797 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3798 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
3799 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
3800 +aggj1(l,4)*muij(4))&
3802 *fac_shield(i)*fac_shield(j) &
3803 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3805 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3808 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3809 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3810 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3811 .and. num_conti.le.maxconts) then
3812 ! write (iout,*) i,j," entered corr"
3814 ! Calculate the contact function. The ith column of the array JCONT will
3815 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3816 ! greater than I). The arrays FACONT and GACONT will contain the values of
3817 ! the contact function and its derivative.
3818 ! r0ij=1.02D0*rpp(iteli,itelj)
3819 ! r0ij=1.11D0*rpp(iteli,itelj)
3820 r0ij=2.20D0*rpp(iteli,itelj)
3821 ! r0ij=1.55D0*rpp(iteli,itelj)
3822 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3823 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3824 if (fcont.gt.0.0D0) then
3825 num_conti=num_conti+1
3826 if (num_conti.gt.maxconts) then
3827 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3828 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3829 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3830 ' will skip next contacts for this conf.', num_conti
3832 jcont_hb(num_conti,i)=j
3833 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3834 !d & " jcont_hb",jcont_hb(num_conti,i)
3835 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3836 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3837 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3839 d_cont(num_conti,i)=rij
3840 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3841 ! --- Electrostatic-interaction matrix ---
3842 a_chuj(1,1,num_conti,i)=a22
3843 a_chuj(1,2,num_conti,i)=a23
3844 a_chuj(2,1,num_conti,i)=a32
3845 a_chuj(2,2,num_conti,i)=a33
3846 ! --- Gradient of rij
3848 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3855 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3856 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3857 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3858 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3859 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3864 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3865 ! Calculate contact energies
3867 wij=cosa-3.0D0*cosb*cosg
3870 ! fac3=dsqrt(-ael6i)/r0ij**3
3871 fac3=dsqrt(-ael6i)*r3ij
3872 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3873 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3874 if (ees0tmp.gt.0) then
3875 ees0pij=dsqrt(ees0tmp)
3879 if (shield_mode.eq.0) then
3883 ees0plist(num_conti,i)=j
3885 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3886 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3887 if (ees0tmp.gt.0) then
3888 ees0mij=dsqrt(ees0tmp)
3893 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
3895 *fac_shield(i)*fac_shield(j)
3897 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
3899 *fac_shield(i)*fac_shield(j)
3901 ! Diagnostics. Comment out or remove after debugging!
3902 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3903 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3904 ! ees0m(num_conti,i)=0.0D0
3906 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3907 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3908 ! Angular derivatives of the contact function
3909 ees0pij1=fac3/ees0pij
3910 ees0mij1=fac3/ees0mij
3911 fac3p=-3.0D0*fac3*rrmij
3912 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3913 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3915 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3916 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3917 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3918 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3919 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3920 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3921 ecosap=ecosa1+ecosa2
3922 ecosbp=ecosb1+ecosb2
3923 ecosgp=ecosg1+ecosg2
3924 ecosam=ecosa1-ecosa2
3925 ecosbm=ecosb1-ecosb2
3926 ecosgm=ecosg1-ecosg2
3935 facont_hb(num_conti,i)=fcont
3936 fprimcont=fprimcont/rij
3937 !d facont_hb(num_conti,i)=1.0D0
3938 ! Following line is for diagnostics.
3941 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3942 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3945 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3946 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3948 gggp(1)=gggp(1)+ees0pijp*xj &
3949 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3950 gggp(2)=gggp(2)+ees0pijp*yj &
3951 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3952 gggp(3)=gggp(3)+ees0pijp*zj &
3953 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3955 gggm(1)=gggm(1)+ees0mijp*xj &
3956 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
3958 gggm(2)=gggm(2)+ees0mijp*yj &
3959 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
3961 gggm(3)=gggm(3)+ees0mijp*zj &
3962 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
3964 ! Derivatives due to the contact function
3965 gacont_hbr(1,num_conti,i)=fprimcont*xj
3966 gacont_hbr(2,num_conti,i)=fprimcont*yj
3967 gacont_hbr(3,num_conti,i)=fprimcont*zj
3970 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
3971 ! following the change of gradient-summation algorithm.
3973 !grad ghalfp=0.5D0*gggp(k)
3974 !grad ghalfm=0.5D0*gggm(k)
3975 gacontp_hb1(k,num_conti,i)= & !ghalfp+
3976 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3977 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3978 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3980 gacontp_hb2(k,num_conti,i)= & !ghalfp+
3981 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3982 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3983 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3985 gacontp_hb3(k,num_conti,i)=gggp(k) &
3986 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3988 gacontm_hb1(k,num_conti,i)= & !ghalfm+
3989 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3990 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
3991 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3993 gacontm_hb2(k,num_conti,i)= & !ghalfm+
3994 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3995 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
3996 *sss_ele_cut*fac_shield(i)*fac_shield(j)
3998 gacontm_hb3(k,num_conti,i)=gggm(k) &
3999 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4002 ! Diagnostics. Comment out or remove after debugging!
4004 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4005 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4006 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4007 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4008 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4009 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4012 endif ! num_conti.le.maxconts
4015 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4018 ghalf=0.5d0*agg(l,k)
4019 aggi(l,k)=aggi(l,k)+ghalf
4020 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4021 aggj(l,k)=aggj(l,k)+ghalf
4024 if (j.eq.nres-1 .and. i.lt.j-2) then
4027 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4033 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4035 end subroutine eelecij
4036 !-----------------------------------------------------------------------------
4037 subroutine eturn3(i,eello_turn3)
4038 ! Third- and fourth-order contributions from turns
4041 ! implicit real*8 (a-h,o-z)
4042 ! include 'DIMENSIONS'
4043 ! include 'COMMON.IOUNITS'
4044 ! include 'COMMON.GEO'
4045 ! include 'COMMON.VAR'
4046 ! include 'COMMON.LOCAL'
4047 ! include 'COMMON.CHAIN'
4048 ! include 'COMMON.DERIV'
4049 ! include 'COMMON.INTERACT'
4050 ! include 'COMMON.CONTACTS'
4051 ! include 'COMMON.TORSION'
4052 ! include 'COMMON.VECTORS'
4053 ! include 'COMMON.FFIELD'
4054 ! include 'COMMON.CONTROL'
4055 real(kind=8),dimension(3) :: ggg
4056 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4057 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4058 real(kind=8),dimension(2) :: auxvec,auxvec1
4059 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4060 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4061 !el integer :: num_conti,j1,j2
4062 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4063 !el dz_normi,xmedi,ymedi,zmedi
4065 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4066 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4069 integer :: i,j,l,k,ilist,iresshield
4070 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4073 ! write (iout,*) "eturn3",i,j,j1,j2
4074 zj=(c(3,j)+c(3,j+1))/2.0d0
4076 if (zj.lt.0) zj=zj+boxzsize
4077 if ((zj.lt.0)) write (*,*) "CHUJ"
4078 if ((zj.gt.bordlipbot) &
4079 .and.(zj.lt.bordliptop)) then
4080 !C the energy transfer exist
4081 if (zj.lt.buflipbot) then
4082 !C what fraction I am in
4084 ((zj-bordlipbot)/lipbufthick)
4085 !C lipbufthick is thickenes of lipid buffore
4086 sslipj=sscalelip(fracinbuf)
4087 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4088 elseif (zj.gt.bufliptop) then
4089 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4090 sslipj=sscalelip(fracinbuf)
4091 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4105 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4107 ! Third-order contributions
4114 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4115 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4116 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4117 call transpose2(auxmat(1,1),auxmat1(1,1))
4118 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4119 if (shield_mode.eq.0) then
4124 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4125 *fac_shield(i)*fac_shield(j) &
4126 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4128 0.5d0*(pizda(1,1)+pizda(2,2)) &
4129 *fac_shield(i)*fac_shield(j)
4131 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4132 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4133 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4134 (shield_mode.gt.0)) then
4137 do ilist=1,ishield_list(i)
4138 iresshield=shield_list(ilist,i)
4140 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4141 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4143 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4144 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4148 do ilist=1,ishield_list(j)
4149 iresshield=shield_list(ilist,j)
4151 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4152 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4154 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4155 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4162 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4163 grad_shield(k,i)*eello_t3/fac_shield(i)
4164 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4165 grad_shield(k,j)*eello_t3/fac_shield(j)
4166 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4167 grad_shield(k,i)*eello_t3/fac_shield(i)
4168 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4169 grad_shield(k,j)*eello_t3/fac_shield(j)
4173 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4174 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4175 !d & ' eello_turn3_num',4*eello_turn3_num
4176 ! Derivatives in gamma(i)
4177 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4178 call transpose2(auxmat2(1,1),auxmat3(1,1))
4179 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4180 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4181 *fac_shield(i)*fac_shield(j) &
4182 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4183 ! Derivatives in gamma(i+1)
4184 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4185 call transpose2(auxmat2(1,1),auxmat3(1,1))
4186 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4187 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4188 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4189 *fac_shield(i)*fac_shield(j) &
4190 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4192 ! Cartesian derivatives
4194 ! ghalf1=0.5d0*agg(l,1)
4195 ! ghalf2=0.5d0*agg(l,2)
4196 ! ghalf3=0.5d0*agg(l,3)
4197 ! ghalf4=0.5d0*agg(l,4)
4198 a_temp(1,1)=aggi(l,1)!+ghalf1
4199 a_temp(1,2)=aggi(l,2)!+ghalf2
4200 a_temp(2,1)=aggi(l,3)!+ghalf3
4201 a_temp(2,2)=aggi(l,4)!+ghalf4
4202 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4203 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4204 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4205 *fac_shield(i)*fac_shield(j) &
4206 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4208 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4209 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4210 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4211 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4212 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4213 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4214 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4215 *fac_shield(i)*fac_shield(j) &
4216 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4218 a_temp(1,1)=aggj(l,1)!+ghalf1
4219 a_temp(1,2)=aggj(l,2)!+ghalf2
4220 a_temp(2,1)=aggj(l,3)!+ghalf3
4221 a_temp(2,2)=aggj(l,4)!+ghalf4
4222 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4223 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4224 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4225 *fac_shield(i)*fac_shield(j) &
4226 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4228 a_temp(1,1)=aggj1(l,1)
4229 a_temp(1,2)=aggj1(l,2)
4230 a_temp(2,1)=aggj1(l,3)
4231 a_temp(2,2)=aggj1(l,4)
4232 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4233 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4234 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4235 *fac_shield(i)*fac_shield(j) &
4236 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4238 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4239 ssgradlipi*eello_t3/4.0d0*lipscale
4240 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4241 ssgradlipj*eello_t3/4.0d0*lipscale
4242 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4243 ssgradlipi*eello_t3/4.0d0*lipscale
4244 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4245 ssgradlipj*eello_t3/4.0d0*lipscale
4248 end subroutine eturn3
4249 !-----------------------------------------------------------------------------
4250 subroutine eturn4(i,eello_turn4)
4251 ! Third- and fourth-order contributions from turns
4254 ! implicit real*8 (a-h,o-z)
4255 ! include 'DIMENSIONS'
4256 ! include 'COMMON.IOUNITS'
4257 ! include 'COMMON.GEO'
4258 ! include 'COMMON.VAR'
4259 ! include 'COMMON.LOCAL'
4260 ! include 'COMMON.CHAIN'
4261 ! include 'COMMON.DERIV'
4262 ! include 'COMMON.INTERACT'
4263 ! include 'COMMON.CONTACTS'
4264 ! include 'COMMON.TORSION'
4265 ! include 'COMMON.VECTORS'
4266 ! include 'COMMON.FFIELD'
4267 ! include 'COMMON.CONTROL'
4268 real(kind=8),dimension(3) :: ggg
4269 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4270 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4271 real(kind=8),dimension(2) :: auxvec,auxvec1
4272 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4273 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4274 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4275 !el dz_normi,xmedi,ymedi,zmedi
4276 !el integer :: num_conti,j1,j2
4277 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4278 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4281 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4282 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4286 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4288 ! Fourth-order contributions
4296 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4297 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4298 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4299 zj=(c(3,j)+c(3,j+1))/2.0d0
4301 if (zj.lt.0) zj=zj+boxzsize
4302 if ((zj.gt.bordlipbot) &
4303 .and.(zj.lt.bordliptop)) then
4304 !C the energy transfer exist
4305 if (zj.lt.buflipbot) then
4306 !C what fraction I am in
4308 ((zj-bordlipbot)/lipbufthick)
4309 !C lipbufthick is thickenes of lipid buffore
4310 sslipj=sscalelip(fracinbuf)
4311 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4312 elseif (zj.gt.bufliptop) then
4313 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4314 sslipj=sscalelip(fracinbuf)
4315 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4329 iti1=itortyp(itype(i+1,1))
4330 iti2=itortyp(itype(i+2,1))
4331 iti3=itortyp(itype(i+3,1))
4332 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4333 call transpose2(EUg(1,1,i+1),e1t(1,1))
4334 call transpose2(Eug(1,1,i+2),e2t(1,1))
4335 call transpose2(Eug(1,1,i+3),e3t(1,1))
4336 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4337 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4338 s1=scalar2(b1(1,iti2),auxvec(1))
4339 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4340 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4341 s2=scalar2(b1(1,iti1),auxvec(1))
4342 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4343 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4344 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4345 if (shield_mode.eq.0) then
4350 eello_turn4=eello_turn4-(s1+s2+s3) &
4351 *fac_shield(i)*fac_shield(j) &
4352 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4353 eello_t4=-(s1+s2+s3) &
4354 *fac_shield(i)*fac_shield(j)
4355 !C Now derivative over shield:
4356 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4357 (shield_mode.gt.0)) then
4360 do ilist=1,ishield_list(i)
4361 iresshield=shield_list(ilist,i)
4363 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4364 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4366 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4367 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4371 do ilist=1,ishield_list(j)
4372 iresshield=shield_list(ilist,j)
4374 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4375 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4377 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4378 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4385 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4386 grad_shield(k,i)*eello_t4/fac_shield(i)
4387 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4388 grad_shield(k,j)*eello_t4/fac_shield(j)
4389 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4390 grad_shield(k,i)*eello_t4/fac_shield(i)
4391 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4392 grad_shield(k,j)*eello_t4/fac_shield(j)
4396 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4397 'eturn4',i,j,-(s1+s2+s3)
4398 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4399 !d & ' eello_turn4_num',8*eello_turn4_num
4400 ! Derivatives in gamma(i)
4401 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4402 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4403 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4404 s1=scalar2(b1(1,iti2),auxvec(1))
4405 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4406 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4407 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4408 *fac_shield(i)*fac_shield(j) &
4409 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4411 ! Derivatives in gamma(i+1)
4412 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4413 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4414 s2=scalar2(b1(1,iti1),auxvec(1))
4415 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4416 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4417 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4418 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4419 *fac_shield(i)*fac_shield(j) &
4420 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4422 ! Derivatives in gamma(i+2)
4423 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4424 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4425 s1=scalar2(b1(1,iti2),auxvec(1))
4426 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4427 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4428 s2=scalar2(b1(1,iti1),auxvec(1))
4429 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4430 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4431 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4432 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4433 *fac_shield(i)*fac_shield(j) &
4434 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4436 ! Cartesian derivatives
4437 ! Derivatives of this turn contributions in DC(i+2)
4438 if (j.lt.nres-1) then
4440 a_temp(1,1)=agg(l,1)
4441 a_temp(1,2)=agg(l,2)
4442 a_temp(2,1)=agg(l,3)
4443 a_temp(2,2)=agg(l,4)
4444 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4445 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4446 s1=scalar2(b1(1,iti2),auxvec(1))
4447 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4448 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4449 s2=scalar2(b1(1,iti1),auxvec(1))
4450 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4451 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4452 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4454 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4455 *fac_shield(i)*fac_shield(j) &
4456 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4460 ! Remaining derivatives of this turn contribution
4462 a_temp(1,1)=aggi(l,1)
4463 a_temp(1,2)=aggi(l,2)
4464 a_temp(2,1)=aggi(l,3)
4465 a_temp(2,2)=aggi(l,4)
4466 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4467 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4468 s1=scalar2(b1(1,iti2),auxvec(1))
4469 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4470 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4471 s2=scalar2(b1(1,iti1),auxvec(1))
4472 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4473 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4474 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4475 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4476 *fac_shield(i)*fac_shield(j) &
4477 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4480 a_temp(1,1)=aggi1(l,1)
4481 a_temp(1,2)=aggi1(l,2)
4482 a_temp(2,1)=aggi1(l,3)
4483 a_temp(2,2)=aggi1(l,4)
4484 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4485 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4486 s1=scalar2(b1(1,iti2),auxvec(1))
4487 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4488 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4489 s2=scalar2(b1(1,iti1),auxvec(1))
4490 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4491 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4492 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4493 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4494 *fac_shield(i)*fac_shield(j) &
4495 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4498 a_temp(1,1)=aggj(l,1)
4499 a_temp(1,2)=aggj(l,2)
4500 a_temp(2,1)=aggj(l,3)
4501 a_temp(2,2)=aggj(l,4)
4502 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4503 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4504 s1=scalar2(b1(1,iti2),auxvec(1))
4505 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4506 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4507 s2=scalar2(b1(1,iti1),auxvec(1))
4508 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4509 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4510 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4511 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4512 *fac_shield(i)*fac_shield(j) &
4513 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4516 a_temp(1,1)=aggj1(l,1)
4517 a_temp(1,2)=aggj1(l,2)
4518 a_temp(2,1)=aggj1(l,3)
4519 a_temp(2,2)=aggj1(l,4)
4520 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4521 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4522 s1=scalar2(b1(1,iti2),auxvec(1))
4523 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4524 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4525 s2=scalar2(b1(1,iti1),auxvec(1))
4526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4527 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4528 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4529 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4530 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4531 *fac_shield(i)*fac_shield(j) &
4532 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4535 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4536 ssgradlipi*eello_t4/4.0d0*lipscale
4537 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4538 ssgradlipj*eello_t4/4.0d0*lipscale
4539 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4540 ssgradlipi*eello_t4/4.0d0*lipscale
4541 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4542 ssgradlipj*eello_t4/4.0d0*lipscale
4545 end subroutine eturn4
4546 !-----------------------------------------------------------------------------
4547 subroutine unormderiv(u,ugrad,unorm,ungrad)
4548 ! This subroutine computes the derivatives of a normalized vector u, given
4549 ! the derivatives computed without normalization conditions, ugrad. Returns
4552 real(kind=8),dimension(3) :: u,vec
4553 real(kind=8),dimension(3,3) ::ugrad,ungrad
4554 real(kind=8) :: unorm !,scalar
4556 ! write (2,*) 'ugrad',ugrad
4559 vec(i)=scalar(ugrad(1,i),u(1))
4561 ! write (2,*) 'vec',vec
4564 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4567 ! write (2,*) 'ungrad',ungrad
4569 end subroutine unormderiv
4570 !-----------------------------------------------------------------------------
4571 subroutine escp_soft_sphere(evdw2,evdw2_14)
4573 ! This subroutine calculates the excluded-volume interaction energy between
4574 ! peptide-group centers and side chains and its gradient in virtual-bond and
4575 ! side-chain vectors.
4577 ! implicit real*8 (a-h,o-z)
4578 ! include 'DIMENSIONS'
4579 ! include 'COMMON.GEO'
4580 ! include 'COMMON.VAR'
4581 ! include 'COMMON.LOCAL'
4582 ! include 'COMMON.CHAIN'
4583 ! include 'COMMON.DERIV'
4584 ! include 'COMMON.INTERACT'
4585 ! include 'COMMON.FFIELD'
4586 ! include 'COMMON.IOUNITS'
4587 ! include 'COMMON.CONTROL'
4588 real(kind=8),dimension(3) :: ggg
4590 integer :: i,iint,j,k,iteli,itypj
4591 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4592 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4597 !d print '(a)','Enter ESCP'
4598 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4599 do i=iatscp_s,iatscp_e
4600 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4602 xi=0.5D0*(c(1,i)+c(1,i+1))
4603 yi=0.5D0*(c(2,i)+c(2,i+1))
4604 zi=0.5D0*(c(3,i)+c(3,i+1))
4606 do iint=1,nscp_gr(i)
4608 do j=iscpstart(i,iint),iscpend(i,iint)
4609 if (itype(j,1).eq.ntyp1) cycle
4610 itypj=iabs(itype(j,1))
4611 ! Uncomment following three lines for SC-p interactions
4615 ! Uncomment following three lines for Ca-p interactions
4619 rij=xj*xj+yj*yj+zj*zj
4622 if (rij.lt.r0ijsq) then
4623 evdwij=0.25d0*(rij-r0ijsq)**2
4631 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4636 !grad if (j.lt.i) then
4637 !d write (iout,*) 'j<i'
4638 ! Uncomment following three lines for SC-p interactions
4640 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4643 !d write (iout,*) 'j>i'
4645 !grad ggg(k)=-ggg(k)
4646 ! Uncomment following line for SC-p interactions
4647 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4651 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4653 !grad kstart=min0(i+1,j)
4654 !grad kend=max0(i-1,j-1)
4655 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4656 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4657 !grad do k=kstart,kend
4659 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4663 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4664 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4671 end subroutine escp_soft_sphere
4672 !-----------------------------------------------------------------------------
4673 subroutine escp(evdw2,evdw2_14)
4675 ! This subroutine calculates the excluded-volume interaction energy between
4676 ! peptide-group centers and side chains and its gradient in virtual-bond and
4677 ! side-chain vectors.
4679 ! implicit real*8 (a-h,o-z)
4680 ! include 'DIMENSIONS'
4681 ! include 'COMMON.GEO'
4682 ! include 'COMMON.VAR'
4683 ! include 'COMMON.LOCAL'
4684 ! include 'COMMON.CHAIN'
4685 ! include 'COMMON.DERIV'
4686 ! include 'COMMON.INTERACT'
4687 ! include 'COMMON.FFIELD'
4688 ! include 'COMMON.IOUNITS'
4689 ! include 'COMMON.CONTROL'
4690 real(kind=8),dimension(3) :: ggg
4692 integer :: i,iint,j,k,iteli,itypj,subchap
4693 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4695 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4696 dist_temp, dist_init
4697 integer xshift,yshift,zshift
4701 !d print '(a)','Enter ESCP'
4702 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4703 do i=iatscp_s,iatscp_e
4704 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4706 xi=0.5D0*(c(1,i)+c(1,i+1))
4707 yi=0.5D0*(c(2,i)+c(2,i+1))
4708 zi=0.5D0*(c(3,i)+c(3,i+1))
4710 if (xi.lt.0) xi=xi+boxxsize
4712 if (yi.lt.0) yi=yi+boxysize
4714 if (zi.lt.0) zi=zi+boxzsize
4716 do iint=1,nscp_gr(i)
4718 do j=iscpstart(i,iint),iscpend(i,iint)
4719 itypj=iabs(itype(j,1))
4720 if (itypj.eq.ntyp1) cycle
4721 ! Uncomment following three lines for SC-p interactions
4725 ! Uncomment following three lines for Ca-p interactions
4733 if (xj.lt.0) xj=xj+boxxsize
4735 if (yj.lt.0) yj=yj+boxysize
4737 if (zj.lt.0) zj=zj+boxzsize
4738 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4746 xj=xj_safe+xshift*boxxsize
4747 yj=yj_safe+yshift*boxysize
4748 zj=zj_safe+zshift*boxzsize
4749 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4750 if(dist_temp.lt.dist_init) then
4760 if (subchap.eq.1) then
4770 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4771 rij=dsqrt(1.0d0/rrij)
4772 sss_ele_cut=sscale_ele(rij)
4773 sss_ele_grad=sscagrad_ele(rij)
4774 ! print *,sss_ele_cut,sss_ele_grad,&
4775 ! (rij),r_cut_ele,rlamb_ele
4776 if (sss_ele_cut.le.0.0) cycle
4778 e1=fac*fac*aad(itypj,iteli)
4779 e2=fac*bad(itypj,iteli)
4780 if (iabs(j-i) .le. 2) then
4783 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
4786 evdw2=evdw2+evdwij*sss_ele_cut
4787 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
4788 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
4789 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4792 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4794 fac=-(evdwij+e1)*rrij*sss_ele_cut
4795 fac=fac+evdwij*sss_ele_grad/rij/expon
4799 !grad if (j.lt.i) then
4800 !d write (iout,*) 'j<i'
4801 ! Uncomment following three lines for SC-p interactions
4803 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4806 !d write (iout,*) 'j>i'
4808 !grad ggg(k)=-ggg(k)
4809 ! Uncomment following line for SC-p interactions
4810 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4811 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4815 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4817 !grad kstart=min0(i+1,j)
4818 !grad kend=max0(i-1,j-1)
4819 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4820 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4821 !grad do k=kstart,kend
4823 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4827 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4828 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4836 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4837 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4838 gradx_scp(j,i)=expon*gradx_scp(j,i)
4841 !******************************************************************************
4845 ! To save time the factor EXPON has been extracted from ALL components
4846 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
4849 !******************************************************************************
4852 !-----------------------------------------------------------------------------
4853 subroutine edis(ehpb)
4855 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4857 ! implicit real*8 (a-h,o-z)
4858 ! include 'DIMENSIONS'
4859 ! include 'COMMON.SBRIDGE'
4860 ! include 'COMMON.CHAIN'
4861 ! include 'COMMON.DERIV'
4862 ! include 'COMMON.VAR'
4863 ! include 'COMMON.INTERACT'
4864 ! include 'COMMON.IOUNITS'
4865 real(kind=8),dimension(3) :: ggg
4867 integer :: i,j,ii,jj,iii,jjj,k
4868 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
4871 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4872 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
4873 if (link_end.eq.0) return
4874 do i=link_start,link_end
4875 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4876 ! CA-CA distance used in regularization of structure.
4879 ! iii and jjj point to the residues for which the distance is assigned.
4880 if (ii.gt.nres) then
4887 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4888 ! & dhpb(i),dhpb1(i),forcon(i)
4889 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
4890 ! distance and angle dependent SS bond potential.
4891 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4892 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4893 if (.not.dyn_ss .and. i.le.nss) then
4894 ! 15/02/13 CC dynamic SSbond - additional check
4895 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
4896 iabs(itype(jjj,1)).eq.1) then
4897 call ssbond_ene(iii,jjj,eij)
4899 !d write (iout,*) "eij",eij
4901 else if (ii.gt.nres .and. jj.gt.nres) then
4902 !c Restraints from contact prediction
4904 if (constr_dist.eq.11) then
4905 ehpb=ehpb+fordepth(i)**4.0d0 &
4906 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4907 fac=fordepth(i)**4.0d0 &
4908 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4909 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
4912 if (dhpb1(i).gt.0.0d0) then
4913 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4914 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4915 !c write (iout,*) "beta nmr",
4916 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4920 !C Get the force constant corresponding to this distance.
4922 !C Calculate the contribution to energy.
4923 ehpb=ehpb+waga*rdis*rdis
4924 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
4926 !C Evaluate gradient.
4932 ggg(j)=fac*(c(j,jj)-c(j,ii))
4935 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4936 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4939 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4940 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4944 if (constr_dist.eq.11) then
4945 ehpb=ehpb+fordepth(i)**4.0d0 &
4946 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
4947 fac=fordepth(i)**4.0d0 &
4948 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
4949 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
4952 if (dhpb1(i).gt.0.0d0) then
4953 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4954 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4955 !c write (iout,*) "alph nmr",
4956 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4959 !C Get the force constant corresponding to this distance.
4961 !C Calculate the contribution to energy.
4962 ehpb=ehpb+waga*rdis*rdis
4963 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4965 !C Evaluate gradient.
4972 ggg(j)=fac*(c(j,jj)-c(j,ii))
4974 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4975 !C If this is a SC-SC distance, we need to calculate the contributions to the
4976 !C Cartesian gradient in the SC vectors (ghpbx).
4979 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4980 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4983 !cgrad do j=iii,jjj-1
4985 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4989 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4990 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4994 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
4998 !-----------------------------------------------------------------------------
4999 subroutine ssbond_ene(i,j,eij)
5001 ! Calculate the distance and angle dependent SS-bond potential energy
5002 ! using a free-energy function derived based on RHF/6-31G** ab initio
5003 ! calculations of diethyl disulfide.
5005 ! A. Liwo and U. Kozlowska, 11/24/03
5007 ! implicit real*8 (a-h,o-z)
5008 ! include 'DIMENSIONS'
5009 ! include 'COMMON.SBRIDGE'
5010 ! include 'COMMON.CHAIN'
5011 ! include 'COMMON.DERIV'
5012 ! include 'COMMON.LOCAL'
5013 ! include 'COMMON.INTERACT'
5014 ! include 'COMMON.VAR'
5015 ! include 'COMMON.IOUNITS'
5016 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5018 integer :: i,j,itypi,itypj,k
5019 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5020 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5021 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5024 itypi=iabs(itype(i,1))
5028 dxi=dc_norm(1,nres+i)
5029 dyi=dc_norm(2,nres+i)
5030 dzi=dc_norm(3,nres+i)
5031 ! dsci_inv=dsc_inv(itypi)
5032 dsci_inv=vbld_inv(nres+i)
5033 itypj=iabs(itype(j,1))
5034 ! dscj_inv=dsc_inv(itypj)
5035 dscj_inv=vbld_inv(nres+j)
5039 dxj=dc_norm(1,nres+j)
5040 dyj=dc_norm(2,nres+j)
5041 dzj=dc_norm(3,nres+j)
5042 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5047 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5048 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5049 om12=dxi*dxj+dyi*dyj+dzi*dzj
5051 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5052 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5058 deltat12=om2-om1+2.0d0
5060 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5061 +akct*deltad*deltat12 &
5062 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5063 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5064 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5065 ! & " deltat12",deltat12," eij",eij
5066 ed=2*akcm*deltad+akct*deltat12
5068 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5069 eom1=-2*akth*deltat1-pom1-om2*pom2
5070 eom2= 2*akth*deltat2+pom1-om1*pom2
5073 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5074 ghpbx(k,i)=ghpbx(k,i)-ggk &
5075 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5076 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5077 ghpbx(k,j)=ghpbx(k,j)+ggk &
5078 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5079 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5080 ghpbc(k,i)=ghpbc(k,i)-ggk
5081 ghpbc(k,j)=ghpbc(k,j)+ggk
5084 ! Calculate the components of the gradient in DC and X
5088 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5092 end subroutine ssbond_ene
5093 !-----------------------------------------------------------------------------
5094 subroutine ebond(estr)
5096 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5098 ! implicit real*8 (a-h,o-z)
5099 ! include 'DIMENSIONS'
5100 ! include 'COMMON.LOCAL'
5101 ! include 'COMMON.GEO'
5102 ! include 'COMMON.INTERACT'
5103 ! include 'COMMON.DERIV'
5104 ! include 'COMMON.VAR'
5105 ! include 'COMMON.CHAIN'
5106 ! include 'COMMON.IOUNITS'
5107 ! include 'COMMON.NAMES'
5108 ! include 'COMMON.FFIELD'
5109 ! include 'COMMON.CONTROL'
5110 ! include 'COMMON.SETUP'
5111 real(kind=8),dimension(3) :: u,ud
5113 integer :: i,j,iti,nbi,k
5114 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5119 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5120 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5122 do i=ibondp_start,ibondp_end
5123 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5124 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5125 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5127 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5128 !C *dc(j,i-1)/vbld(i)
5130 !C if (energy_dec) write(iout,*) &
5131 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5132 diff = vbld(i)-vbldpDUM
5134 diff = vbld(i)-vbldp0
5136 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5137 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5140 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5142 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5145 estr=0.5d0*AKP*estr+estr1
5147 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5149 do i=ibond_start,ibond_end
5150 iti=iabs(itype(i,1))
5151 if (iti.ne.10 .and. iti.ne.ntyp1) then
5154 diff=vbld(i+nres)-vbldsc0(1,iti)
5155 if (energy_dec) write (iout,*) &
5156 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5157 AKSC(1,iti),AKSC(1,iti)*diff*diff
5158 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5160 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5164 diff=vbld(i+nres)-vbldsc0(j,iti)
5165 ud(j)=aksc(j,iti)*diff
5166 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5180 uprod2=uprod2*u(k)*u(k)
5184 usumsqder=usumsqder+ud(j)*uprod2
5186 estr=estr+uprod/usum
5187 if (energy_dec) write (iout,*) &
5188 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5189 AKSC(1,iti),AKSC(1,iti)*diff*diff
5191 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5197 end subroutine ebond
5199 !-----------------------------------------------------------------------------
5200 subroutine ebend(etheta)
5202 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5203 ! angles gamma and its derivatives in consecutive thetas and gammas.
5206 ! implicit real*8 (a-h,o-z)
5207 ! include 'DIMENSIONS'
5208 ! include 'COMMON.LOCAL'
5209 ! include 'COMMON.GEO'
5210 ! include 'COMMON.INTERACT'
5211 ! include 'COMMON.DERIV'
5212 ! include 'COMMON.VAR'
5213 ! include 'COMMON.CHAIN'
5214 ! include 'COMMON.IOUNITS'
5215 ! include 'COMMON.NAMES'
5216 ! include 'COMMON.FFIELD'
5217 ! include 'COMMON.CONTROL'
5218 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5219 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5220 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5222 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5223 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5224 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5226 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5228 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5229 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5230 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5231 real(kind=8),dimension(2) :: y,z
5234 ! time11=dexp(-2*time)
5237 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5238 do i=ithet_start,ithet_end
5239 if (itype(i-1,1).eq.ntyp1) cycle
5240 ! Zero the energy function and its derivative at 0 or pi.
5241 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5243 ichir1=isign(1,itype(i-2,1))
5244 ichir2=isign(1,itype(i,1))
5245 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5246 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5247 if (itype(i-1,1).eq.10) then
5248 itype1=isign(10,itype(i-2,1))
5249 ichir11=isign(1,itype(i-2,1))
5250 ichir12=isign(1,itype(i-2,1))
5251 itype2=isign(10,itype(i,1))
5252 ichir21=isign(1,itype(i,1))
5253 ichir22=isign(1,itype(i,1))
5256 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5259 if (phii.ne.phii) phii=150.0
5269 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5272 if (phii1.ne.phii1) phii1=150.0
5284 ! Calculate the "mean" value of theta from the part of the distribution
5285 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5286 ! In following comments this theta will be referred to as t_c.
5287 thet_pred_mean=0.0d0
5289 athetk=athet(k,it,ichir1,ichir2)
5290 bthetk=bthet(k,it,ichir1,ichir2)
5292 athetk=athet(k,itype1,ichir11,ichir12)
5293 bthetk=bthet(k,itype2,ichir21,ichir22)
5295 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5297 dthett=thet_pred_mean*ssd
5298 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5299 ! Derivatives of the "mean" values in gamma1 and gamma2.
5300 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5301 +athet(2,it,ichir1,ichir2)*y(1))*ss
5302 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5303 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5305 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5306 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5307 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5308 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5310 if (theta(i).gt.pi-delta) then
5311 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5313 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5314 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5315 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5317 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5319 else if (theta(i).lt.delta) then
5320 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5321 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5322 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5324 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5325 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5328 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5331 etheta=etheta+ethetai
5332 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5334 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5335 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5336 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5338 ! Ufff.... We've done all this!!!
5340 end subroutine ebend
5341 !-----------------------------------------------------------------------------
5342 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5345 ! implicit real*8 (a-h,o-z)
5346 ! include 'DIMENSIONS'
5347 ! include 'COMMON.LOCAL'
5348 ! include 'COMMON.IOUNITS'
5349 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5350 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5351 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5353 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5355 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5356 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5357 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5359 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5360 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5362 ! Calculate the contributions to both Gaussian lobes.
5363 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5364 ! The "polynomial part" of the "standard deviation" of this part of
5368 sig=sig*thet_pred_mean+polthet(j,it)
5370 ! Derivative of the "interior part" of the "standard deviation of the"
5371 ! gamma-dependent Gaussian lobe in t_c.
5372 sigtc=3*polthet(3,it)
5374 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5377 ! Set the parameters of both Gaussian lobes of the distribution.
5378 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5379 fac=sig*sig+sigc0(it)
5382 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5383 sigsqtc=-4.0D0*sigcsq*sigtc
5384 ! print *,i,sig,sigtc,sigsqtc
5385 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5386 sigtc=-sigtc/(fac*fac)
5387 ! Following variable is sigma(t_c)**(-2)
5388 sigcsq=sigcsq*sigcsq
5390 sig0inv=1.0D0/sig0i**2
5391 delthec=thetai-thet_pred_mean
5392 delthe0=thetai-theta0i
5393 term1=-0.5D0*sigcsq*delthec*delthec
5394 term2=-0.5D0*sig0inv*delthe0*delthe0
5395 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5396 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5397 ! to the energy (this being the log of the distribution) at the end of energy
5398 ! term evaluation for this virtual-bond angle.
5399 if (term1.gt.term2) then
5401 term2=dexp(term2-termm)
5405 term1=dexp(term1-termm)
5408 ! The ratio between the gamma-independent and gamma-dependent lobes of
5409 ! the distribution is a Gaussian function of thet_pred_mean too.
5410 diffak=gthet(2,it)-thet_pred_mean
5411 ratak=diffak/gthet(3,it)**2
5412 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5413 ! Let's differentiate it in thet_pred_mean NOW.
5415 ! Now put together the distribution terms to make complete distribution.
5416 termexp=term1+ak*term2
5417 termpre=sigc+ak*sig0i
5418 ! Contribution of the bending energy from this theta is just the -log of
5419 ! the sum of the contributions from the two lobes and the pre-exponential
5420 ! factor. Simple enough, isn't it?
5421 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5422 ! NOW the derivatives!!!
5423 ! 6/6/97 Take into account the deformation.
5424 E_theta=(delthec*sigcsq*term1 &
5425 +ak*delthe0*sig0inv*term2)/termexp
5426 E_tc=((sigtc+aktc*sig0i)/termpre &
5427 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5428 aktc*term2)/termexp)
5430 end subroutine theteng
5432 !-----------------------------------------------------------------------------
5433 subroutine ebend(etheta,ethetacnstr)
5435 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5436 ! angles gamma and its derivatives in consecutive thetas and gammas.
5437 ! ab initio-derived potentials from
5438 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5440 ! implicit real*8 (a-h,o-z)
5441 ! include 'DIMENSIONS'
5442 ! include 'COMMON.LOCAL'
5443 ! include 'COMMON.GEO'
5444 ! include 'COMMON.INTERACT'
5445 ! include 'COMMON.DERIV'
5446 ! include 'COMMON.VAR'
5447 ! include 'COMMON.CHAIN'
5448 ! include 'COMMON.IOUNITS'
5449 ! include 'COMMON.NAMES'
5450 ! include 'COMMON.FFIELD'
5451 ! include 'COMMON.CONTROL'
5452 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5453 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5454 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5455 logical :: lprn=.false., lprn1=.false.
5457 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5458 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5459 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5460 ! local variables for constrains
5461 real(kind=8) :: difi,thetiii
5465 do i=ithet_start,ithet_end
5466 if (itype(i-1,1).eq.ntyp1) cycle
5467 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5468 if (iabs(itype(i+1,1)).eq.20) iblock=2
5469 if (iabs(itype(i+1,1)).ne.20) iblock=1
5473 theti2=0.5d0*theta(i)
5474 ityp2=ithetyp((itype(i-1,1)))
5476 coskt(k)=dcos(k*theti2)
5477 sinkt(k)=dsin(k*theti2)
5479 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5482 if (phii.ne.phii) phii=150.0
5486 ityp1=ithetyp((itype(i-2,1)))
5487 ! propagation of chirality for glycine type
5489 cosph1(k)=dcos(k*phii)
5490 sinph1(k)=dsin(k*phii)
5494 ityp1=ithetyp(itype(i-2,1))
5500 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5503 if (phii1.ne.phii1) phii1=150.0
5508 ityp3=ithetyp((itype(i,1)))
5510 cosph2(k)=dcos(k*phii1)
5511 sinph2(k)=dsin(k*phii1)
5515 ityp3=ithetyp(itype(i,1))
5521 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5524 ccl=cosph1(l)*cosph2(k-l)
5525 ssl=sinph1(l)*sinph2(k-l)
5526 scl=sinph1(l)*cosph2(k-l)
5527 csl=cosph1(l)*sinph2(k-l)
5528 cosph1ph2(l,k)=ccl-ssl
5529 cosph1ph2(k,l)=ccl+ssl
5530 sinph1ph2(l,k)=scl+csl
5531 sinph1ph2(k,l)=scl-csl
5535 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5536 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5537 write (iout,*) "coskt and sinkt"
5539 write (iout,*) k,coskt(k),sinkt(k)
5543 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5544 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5547 write (iout,*) "k",k,&
5548 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5552 write (iout,*) "cosph and sinph"
5554 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5556 write (iout,*) "cosph1ph2 and sinph2ph2"
5559 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5560 sinph1ph2(l,k),sinph1ph2(k,l)
5563 write(iout,*) "ethetai",ethetai
5567 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5568 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5569 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5570 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5571 ethetai=ethetai+sinkt(m)*aux
5572 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5573 dephii=dephii+k*sinkt(m)* &
5574 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5575 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5576 dephii1=dephii1+k*sinkt(m)* &
5577 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5578 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5580 write (iout,*) "m",m," k",k," bbthet", &
5581 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5582 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5583 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5584 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5588 write(iout,*) "ethetai",ethetai
5592 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5593 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5594 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5595 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5596 ethetai=ethetai+sinkt(m)*aux
5597 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5598 dephii=dephii+l*sinkt(m)* &
5599 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5600 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5601 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5602 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5603 dephii1=dephii1+(k-l)*sinkt(m)* &
5604 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5605 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5606 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5607 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5609 write (iout,*) "m",m," k",k," l",l," ffthet",&
5610 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5611 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5612 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5613 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5615 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5616 cosph1ph2(k,l)*sinkt(m),&
5617 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5625 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5626 i,theta(i)*rad2deg,phii*rad2deg,&
5627 phii1*rad2deg,ethetai
5629 etheta=etheta+ethetai
5630 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5632 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5633 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5634 gloc(nphi+i-2,icg)=wang*dethetai
5636 !-----------thete constrains
5637 ! if (tor_mode.ne.2) then
5639 !C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5640 do i=ithetaconstr_start,ithetaconstr_end
5641 itheta=itheta_constr(i)
5642 thetiii=theta(itheta)
5643 difi=pinorm(thetiii-theta_constr0(i))
5644 if (difi.gt.theta_drange(i)) then
5645 difi=difi-theta_drange(i)
5646 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5647 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5648 +for_thet_constr(i)*difi**3
5649 else if (difi.lt.-drange(i)) then
5651 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5652 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5653 +for_thet_constr(i)*difi**3
5657 if (energy_dec) then
5658 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5659 i,itheta,rad2deg*thetiii, &
5660 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5661 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5662 gloc(itheta+nphi-2,icg)
5668 end subroutine ebend
5671 !-----------------------------------------------------------------------------
5672 subroutine esc(escloc)
5673 ! Calculate the local energy of a side chain and its derivatives in the
5674 ! corresponding virtual-bond valence angles THETA and the spherical angles
5678 ! implicit real*8 (a-h,o-z)
5679 ! include 'DIMENSIONS'
5680 ! include 'COMMON.GEO'
5681 ! include 'COMMON.LOCAL'
5682 ! include 'COMMON.VAR'
5683 ! include 'COMMON.INTERACT'
5684 ! include 'COMMON.DERIV'
5685 ! include 'COMMON.CHAIN'
5686 ! include 'COMMON.IOUNITS'
5687 ! include 'COMMON.NAMES'
5688 ! include 'COMMON.FFIELD'
5689 ! include 'COMMON.CONTROL'
5690 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5691 ddersc0,ddummy,xtemp,temp
5692 !el real(kind=8) :: time11,time12,time112,theti
5693 real(kind=8) :: escloc,delta
5694 !el integer :: it,nlobit
5695 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5698 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5699 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5702 ! write (iout,'(a)') 'ESC'
5703 do i=loc_start,loc_end
5705 if (it.eq.ntyp1) cycle
5706 if (it.eq.10) goto 1
5707 nlobit=nlob(iabs(it))
5708 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5709 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5710 theti=theta(i+1)-pipol
5715 if (x(2).gt.pi-delta) then
5719 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5721 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5722 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5724 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5725 ddersc0(1),dersc(1))
5726 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5727 ddersc0(3),dersc(3))
5729 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5731 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5732 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5733 dersc0(2),esclocbi,dersc02)
5734 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5736 call splinthet(x(2),0.5d0*delta,ss,ssd)
5741 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5743 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5744 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5746 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5748 ! write (iout,*) escloci
5749 else if (x(2).lt.delta) then
5753 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5755 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5756 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5758 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5759 ddersc0(1),dersc(1))
5760 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5761 ddersc0(3),dersc(3))
5763 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5765 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5766 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5767 dersc0(2),esclocbi,dersc02)
5768 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5773 call splinthet(x(2),0.5d0*delta,ss,ssd)
5775 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5777 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5778 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5780 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5781 ! write (iout,*) escloci
5783 call enesc(x,escloci,dersc,ddummy,.false.)
5786 escloc=escloc+escloci
5787 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5789 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5791 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5793 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5794 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5799 !-----------------------------------------------------------------------------
5800 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5803 ! implicit real*8 (a-h,o-z)
5804 ! include 'DIMENSIONS'
5805 ! include 'COMMON.GEO'
5806 ! include 'COMMON.LOCAL'
5807 ! include 'COMMON.IOUNITS'
5808 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5809 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5810 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5811 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5812 real(kind=8) :: escloci
5815 integer :: j,iii,l,k !el,it,nlobit
5816 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5817 !el time11,time12,time112
5818 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5822 if (mixed) ddersc(j)=0.0d0
5826 ! Because of periodicity of the dependence of the SC energy in omega we have
5827 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5828 ! To avoid underflows, first compute & store the exponents.
5836 z(k)=x(k)-censc(k,j,it)
5841 Axk=Axk+gaussc(l,k,j,it)*z(l)
5847 expfac=expfac+Ax(k,j,iii)*z(k)
5855 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5856 ! subsequent NaNs and INFs in energy calculation.
5857 ! Find the largest exponent
5861 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5865 !d print *,'it=',it,' emin=',emin
5867 ! Compute the contribution to SC energy and derivatives
5872 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5873 if(adexp.ne.adexp) adexp=1.0
5876 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5878 !d print *,'j=',j,' expfac=',expfac
5879 escloc_i=escloc_i+expfac
5881 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5885 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
5886 +gaussc(k,2,j,it))*expfac
5893 dersc(1)=dersc(1)/cos(theti)**2
5894 ddersc(1)=ddersc(1)/cos(theti)**2
5897 escloci=-(dlog(escloc_i)-emin)
5899 dersc(j)=dersc(j)/escloc_i
5903 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5907 end subroutine enesc
5908 !-----------------------------------------------------------------------------
5909 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5912 ! implicit real*8 (a-h,o-z)
5913 ! include 'DIMENSIONS'
5914 ! include 'COMMON.GEO'
5915 ! include 'COMMON.LOCAL'
5916 ! include 'COMMON.IOUNITS'
5917 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5918 real(kind=8),dimension(3) :: x,z,dersc
5919 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
5920 real(kind=8),dimension(nlobit) :: contr !(maxlob)
5921 real(kind=8) :: escloci,dersc12,emin
5924 integer :: j,k,l !el,it,nlobit
5925 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
5935 z(k)=x(k)-censc(k,j,it)
5941 Axk=Axk+gaussc(l,k,j,it)*z(l)
5947 expfac=expfac+Ax(k,j)*z(k)
5952 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5953 ! subsequent NaNs and INFs in energy calculation.
5954 ! Find the largest exponent
5957 if (emin.gt.contr(j)) emin=contr(j)
5961 ! Compute the contribution to SC energy and derivatives
5965 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5966 escloc_i=escloc_i+expfac
5968 dersc(k)=dersc(k)+Ax(k,j)*expfac
5970 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
5971 +gaussc(1,2,j,it))*expfac
5975 dersc(1)=dersc(1)/cos(theti)**2
5976 dersc12=dersc12/cos(theti)**2
5977 escloci=-(dlog(escloc_i)-emin)
5979 dersc(j)=dersc(j)/escloc_i
5981 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5983 end subroutine enesc_bound
5985 !-----------------------------------------------------------------------------
5986 subroutine esc(escloc)
5987 ! Calculate the local energy of a side chain and its derivatives in the
5988 ! corresponding virtual-bond valence angles THETA and the spherical angles
5989 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5990 ! added by Urszula Kozlowska. 07/11/2007
5993 ! implicit real*8 (a-h,o-z)
5994 ! include 'DIMENSIONS'
5995 ! include 'COMMON.GEO'
5996 ! include 'COMMON.LOCAL'
5997 ! include 'COMMON.VAR'
5998 ! include 'COMMON.SCROT'
5999 ! include 'COMMON.INTERACT'
6000 ! include 'COMMON.DERIV'
6001 ! include 'COMMON.CHAIN'
6002 ! include 'COMMON.IOUNITS'
6003 ! include 'COMMON.NAMES'
6004 ! include 'COMMON.FFIELD'
6005 ! include 'COMMON.CONTROL'
6006 ! include 'COMMON.VECTORS'
6007 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6008 real(kind=8),dimension(65) :: x
6009 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6010 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6011 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6012 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6013 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6015 integer :: i,j,k !el,it,nlobit
6016 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6017 !el real(kind=8) :: time11,time12,time112,theti
6018 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6019 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6020 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6021 sumene1x,sumene2x,sumene3x,sumene4x,&
6022 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6025 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6026 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6029 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6033 do i=loc_start,loc_end
6034 if (itype(i,1).eq.ntyp1) cycle
6035 costtab(i+1) =dcos(theta(i+1))
6036 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6037 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6038 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6039 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6040 cosfac=dsqrt(cosfac2)
6041 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6042 sinfac=dsqrt(sinfac2)
6044 if (it.eq.10) goto 1
6046 ! Compute the axes of tghe local cartesian coordinates system; store in
6047 ! x_prime, y_prime and z_prime
6054 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6055 ! & dc_norm(3,i+nres)
6057 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6058 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6061 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6064 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6065 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6066 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6067 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6068 ! & " xy",scalar(x_prime(1),y_prime(1)),
6069 ! & " xz",scalar(x_prime(1),z_prime(1)),
6070 ! & " yy",scalar(y_prime(1),y_prime(1)),
6071 ! & " yz",scalar(y_prime(1),z_prime(1)),
6072 ! & " zz",scalar(z_prime(1),z_prime(1))
6074 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6075 ! to local coordinate system. Store in xx, yy, zz.
6081 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6082 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6083 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6090 ! Compute the energy of the ith side cbain
6092 ! write (2,*) "xx",xx," yy",yy," zz",zz
6095 x(j) = sc_parmin(j,it)
6098 !c diagnostics - remove later
6100 yy1 = dsin(alph(2))*dcos(omeg(2))
6101 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6102 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6103 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6105 !," --- ", xx_w,yy_w,zz_w
6108 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6109 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6111 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6112 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6114 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6115 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6116 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6117 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6118 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6120 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6121 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6122 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6123 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6124 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6126 dsc_i = 0.743d0+x(61)
6128 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6129 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6130 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6131 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6132 s1=(1+x(63))/(0.1d0 + dscp1)
6133 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6134 s2=(1+x(65))/(0.1d0 + dscp2)
6135 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6136 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6137 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6138 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6140 ! & dscp1,dscp2,sumene
6141 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6142 escloc = escloc + sumene
6143 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6148 ! This section to check the numerical derivatives of the energy of ith side
6149 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6150 ! #define DEBUG in the code to turn it on.
6152 write (2,*) "sumene =",sumene
6156 write (2,*) xx,yy,zz
6157 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6158 de_dxx_num=(sumenep-sumene)/aincr
6160 write (2,*) "xx+ sumene from enesc=",sumenep
6163 write (2,*) xx,yy,zz
6164 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6165 de_dyy_num=(sumenep-sumene)/aincr
6167 write (2,*) "yy+ sumene from enesc=",sumenep
6170 write (2,*) xx,yy,zz
6171 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6172 de_dzz_num=(sumenep-sumene)/aincr
6174 write (2,*) "zz+ sumene from enesc=",sumenep
6175 costsave=cost2tab(i+1)
6176 sintsave=sint2tab(i+1)
6177 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6178 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6179 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6180 de_dt_num=(sumenep-sumene)/aincr
6181 write (2,*) " t+ sumene from enesc=",sumenep
6182 cost2tab(i+1)=costsave
6183 sint2tab(i+1)=sintsave
6184 ! End of diagnostics section.
6187 ! Compute the gradient of esc
6189 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6190 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6191 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6192 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6193 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6194 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6195 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6196 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6197 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6198 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6199 *(pom_s1/dscp1+pom_s16*dscp1**4)
6200 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6201 *(pom_s2/dscp2+pom_s26*dscp2**4)
6202 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6203 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6204 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6206 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6207 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6208 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6210 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6211 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6214 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6217 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6218 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6219 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6221 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6222 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6223 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6224 +x(59)*zz**2 +x(60)*xx*zz
6225 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6226 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6229 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6232 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6233 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6234 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6235 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6236 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6237 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6238 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6239 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6241 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6244 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6245 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6246 +pom1*pom_dt1+pom2*pom_dt2
6248 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6252 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6253 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6254 cosfac2xx=cosfac2*xx
6255 sinfac2yy=sinfac2*yy
6257 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6259 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6261 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6262 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6263 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6264 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6265 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6266 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6267 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6268 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6269 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6270 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6274 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6275 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6276 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6277 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6280 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6281 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6282 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6283 (z_prime(k)-zz*dC_norm(k,i+nres))
6285 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6286 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6290 dXX_Ctab(k,i)=dXX_Ci(k)
6291 dXX_C1tab(k,i)=dXX_Ci1(k)
6292 dYY_Ctab(k,i)=dYY_Ci(k)
6293 dYY_C1tab(k,i)=dYY_Ci1(k)
6294 dZZ_Ctab(k,i)=dZZ_Ci(k)
6295 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6296 dXX_XYZtab(k,i)=dXX_XYZ(k)
6297 dYY_XYZtab(k,i)=dYY_XYZ(k)
6298 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6302 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6303 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6304 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6305 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6306 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6308 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6309 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6310 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6311 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6312 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6313 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6314 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6315 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6317 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6318 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6320 ! to check gradient call subroutine check_grad
6326 !-----------------------------------------------------------------------------
6327 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6329 real(kind=8),dimension(65) :: x
6330 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6331 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6333 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6334 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6336 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6337 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6339 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6340 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6341 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6342 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6343 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6345 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6346 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6347 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6348 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6349 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6351 dsc_i = 0.743d0+x(61)
6353 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6354 *(xx*cost2+yy*sint2))
6355 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6356 *(xx*cost2-yy*sint2))
6357 s1=(1+x(63))/(0.1d0 + dscp1)
6358 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6359 s2=(1+x(65))/(0.1d0 + dscp2)
6360 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6361 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6362 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6367 !-----------------------------------------------------------------------------
6368 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6370 ! This procedure calculates two-body contact function g(rij) and its derivative:
6373 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6376 ! where x=(rij-r0ij)/delta
6378 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6381 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6382 real(kind=8) :: x,x2,x4,delta
6386 if (x.lt.-1.0D0) then
6389 else if (x.le.1.0D0) then
6392 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6393 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6399 end subroutine gcont
6400 !-----------------------------------------------------------------------------
6401 subroutine splinthet(theti,delta,ss,ssder)
6402 ! implicit real*8 (a-h,o-z)
6403 ! include 'DIMENSIONS'
6404 ! include 'COMMON.VAR'
6405 ! include 'COMMON.GEO'
6406 real(kind=8) :: theti,delta,ss,ssder
6407 real(kind=8) :: thetup,thetlow
6410 if (theti.gt.pipol) then
6411 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6413 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6417 end subroutine splinthet
6418 !-----------------------------------------------------------------------------
6419 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6421 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6422 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6423 a1=fprim0*delta/(f1-f0)
6429 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6430 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6432 end subroutine spline1
6433 !-----------------------------------------------------------------------------
6434 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6436 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6437 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6442 a2=3*(f1x-f0x)-2*fprim0x*delta
6443 a3=fprim0x*delta-2*(f1x-f0x)
6444 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6446 end subroutine spline2
6447 !-----------------------------------------------------------------------------
6449 !-----------------------------------------------------------------------------
6450 subroutine etor(etors,edihcnstr)
6451 ! implicit real*8 (a-h,o-z)
6452 ! include 'DIMENSIONS'
6453 ! include 'COMMON.VAR'
6454 ! include 'COMMON.GEO'
6455 ! include 'COMMON.LOCAL'
6456 ! include 'COMMON.TORSION'
6457 ! include 'COMMON.INTERACT'
6458 ! include 'COMMON.DERIV'
6459 ! include 'COMMON.CHAIN'
6460 ! include 'COMMON.NAMES'
6461 ! include 'COMMON.IOUNITS'
6462 ! include 'COMMON.FFIELD'
6463 ! include 'COMMON.TORCNSTR'
6464 ! include 'COMMON.CONTROL'
6465 real(kind=8) :: etors,edihcnstr
6469 real(kind=8) :: phii,fac,etors_ii
6471 ! Set lprn=.true. for debugging
6475 do i=iphi_start,iphi_end
6477 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6478 .or. itype(i,1).eq.ntyp1) cycle
6479 itori=itortyp(itype(i-2,1))
6480 itori1=itortyp(itype(i-1,1))
6483 ! Proline-Proline pair is a special case...
6484 if (itori.eq.3 .and. itori1.eq.3) then
6485 if (phii.gt.-dwapi3) then
6487 fac=1.0D0/(1.0D0-cosphi)
6488 etorsi=v1(1,3,3)*fac
6489 etorsi=etorsi+etorsi
6490 etors=etors+etorsi-v1(1,3,3)
6491 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6492 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6495 v1ij=v1(j+1,itori,itori1)
6496 v2ij=v2(j+1,itori,itori1)
6499 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6500 if (energy_dec) etors_ii=etors_ii+ &
6501 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6502 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6506 v1ij=v1(j,itori,itori1)
6507 v2ij=v2(j,itori,itori1)
6510 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6511 if (energy_dec) etors_ii=etors_ii+ &
6512 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6513 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6516 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6519 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6520 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6521 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6522 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6523 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6525 ! 6/20/98 - dihedral angle constraints
6528 itori=idih_constr(i)
6531 if (difi.gt.drange(i)) then
6533 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6534 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6535 else if (difi.lt.-drange(i)) then
6537 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6538 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6540 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6541 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6543 ! write (iout,*) 'edihcnstr',edihcnstr
6546 !-----------------------------------------------------------------------------
6547 subroutine etor_d(etors_d)
6548 real(kind=8) :: etors_d
6551 end subroutine etor_d
6553 !-----------------------------------------------------------------------------
6554 subroutine etor(etors,edihcnstr)
6555 ! implicit real*8 (a-h,o-z)
6556 ! include 'DIMENSIONS'
6557 ! include 'COMMON.VAR'
6558 ! include 'COMMON.GEO'
6559 ! include 'COMMON.LOCAL'
6560 ! include 'COMMON.TORSION'
6561 ! include 'COMMON.INTERACT'
6562 ! include 'COMMON.DERIV'
6563 ! include 'COMMON.CHAIN'
6564 ! include 'COMMON.NAMES'
6565 ! include 'COMMON.IOUNITS'
6566 ! include 'COMMON.FFIELD'
6567 ! include 'COMMON.TORCNSTR'
6568 ! include 'COMMON.CONTROL'
6569 real(kind=8) :: etors,edihcnstr
6572 integer :: i,j,iblock,itori,itori1
6573 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6574 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6575 ! Set lprn=.true. for debugging
6579 do i=iphi_start,iphi_end
6580 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6581 .or. itype(i-3,1).eq.ntyp1 &
6582 .or. itype(i,1).eq.ntyp1) cycle
6584 if (iabs(itype(i,1)).eq.20) then
6589 itori=itortyp(itype(i-2,1))
6590 itori1=itortyp(itype(i-1,1))
6593 ! Regular cosine and sine terms
6594 do j=1,nterm(itori,itori1,iblock)
6595 v1ij=v1(j,itori,itori1,iblock)
6596 v2ij=v2(j,itori,itori1,iblock)
6599 etors=etors+v1ij*cosphi+v2ij*sinphi
6600 if (energy_dec) etors_ii=etors_ii+ &
6601 v1ij*cosphi+v2ij*sinphi
6602 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6606 ! E = SUM ----------------------------------- - v1
6607 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6609 cosphi=dcos(0.5d0*phii)
6610 sinphi=dsin(0.5d0*phii)
6611 do j=1,nlor(itori,itori1,iblock)
6612 vl1ij=vlor1(j,itori,itori1)
6613 vl2ij=vlor2(j,itori,itori1)
6614 vl3ij=vlor3(j,itori,itori1)
6615 pom=vl2ij*cosphi+vl3ij*sinphi
6616 pom1=1.0d0/(pom*pom+1.0d0)
6617 etors=etors+vl1ij*pom1
6618 if (energy_dec) etors_ii=etors_ii+ &
6621 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6623 ! Subtract the constant term
6624 etors=etors-v0(itori,itori1,iblock)
6625 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6626 'etor',i,etors_ii-v0(itori,itori1,iblock)
6628 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6629 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6630 (v1(j,itori,itori1,iblock),j=1,6),&
6631 (v2(j,itori,itori1,iblock),j=1,6)
6632 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6633 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6635 ! 6/20/98 - dihedral angle constraints
6637 ! do i=1,ndih_constr
6638 do i=idihconstr_start,idihconstr_end
6639 itori=idih_constr(i)
6641 difi=pinorm(phii-phi0(i))
6642 if (difi.gt.drange(i)) then
6644 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6645 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6646 else if (difi.lt.-drange(i)) then
6648 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6649 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6653 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6654 !d & rad2deg*phi0(i), rad2deg*drange(i),
6655 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6657 !d write (iout,*) 'edihcnstr',edihcnstr
6660 !-----------------------------------------------------------------------------
6661 subroutine etor_d(etors_d)
6662 ! 6/23/01 Compute double torsional energy
6663 ! implicit real*8 (a-h,o-z)
6664 ! include 'DIMENSIONS'
6665 ! include 'COMMON.VAR'
6666 ! include 'COMMON.GEO'
6667 ! include 'COMMON.LOCAL'
6668 ! include 'COMMON.TORSION'
6669 ! include 'COMMON.INTERACT'
6670 ! include 'COMMON.DERIV'
6671 ! include 'COMMON.CHAIN'
6672 ! include 'COMMON.NAMES'
6673 ! include 'COMMON.IOUNITS'
6674 ! include 'COMMON.FFIELD'
6675 ! include 'COMMON.TORCNSTR'
6676 real(kind=8) :: etors_d,etors_d_ii
6679 integer :: i,j,k,l,itori,itori1,itori2,iblock
6680 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6681 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6682 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6683 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6684 ! Set lprn=.true. for debugging
6688 ! write(iout,*) "a tu??"
6689 do i=iphid_start,iphid_end
6691 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6692 .or. itype(i-3,1).eq.ntyp1 &
6693 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6694 itori=itortyp(itype(i-2,1))
6695 itori1=itortyp(itype(i-1,1))
6696 itori2=itortyp(itype(i,1))
6702 if (iabs(itype(i+1,1)).eq.20) iblock=2
6704 ! Regular cosine and sine terms
6705 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6706 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6707 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6708 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6709 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6710 cosphi1=dcos(j*phii)
6711 sinphi1=dsin(j*phii)
6712 cosphi2=dcos(j*phii1)
6713 sinphi2=dsin(j*phii1)
6714 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6715 v2cij*cosphi2+v2sij*sinphi2
6716 if (energy_dec) etors_d_ii=etors_d_ii+ &
6717 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6718 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6719 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6721 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6723 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6724 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6725 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6726 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6727 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6728 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6729 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6730 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6731 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6732 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6733 if (energy_dec) etors_d_ii=etors_d_ii+ &
6734 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6735 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6736 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6737 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6738 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6739 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6742 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6743 'etor_d',i,etors_d_ii
6744 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6745 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6748 end subroutine etor_d
6750 !-----------------------------------------------------------------------------
6751 subroutine eback_sc_corr(esccor)
6752 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6753 ! conformational states; temporarily implemented as differences
6754 ! between UNRES torsional potentials (dependent on three types of
6755 ! residues) and the torsional potentials dependent on all 20 types
6756 ! of residues computed from AM1 energy surfaces of terminally-blocked
6757 ! amino-acid residues.
6758 ! implicit real*8 (a-h,o-z)
6759 ! include 'DIMENSIONS'
6760 ! include 'COMMON.VAR'
6761 ! include 'COMMON.GEO'
6762 ! include 'COMMON.LOCAL'
6763 ! include 'COMMON.TORSION'
6764 ! include 'COMMON.SCCOR'
6765 ! include 'COMMON.INTERACT'
6766 ! include 'COMMON.DERIV'
6767 ! include 'COMMON.CHAIN'
6768 ! include 'COMMON.NAMES'
6769 ! include 'COMMON.IOUNITS'
6770 ! include 'COMMON.FFIELD'
6771 ! include 'COMMON.CONTROL'
6772 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
6775 integer :: i,interty,j,isccori,isccori1,intertyp
6776 ! Set lprn=.true. for debugging
6779 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6781 do i=itau_start,itau_end
6782 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
6784 isccori=isccortyp(itype(i-2,1))
6785 isccori1=isccortyp(itype(i-1,1))
6787 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6789 do intertyp=1,3 !intertyp
6791 !c Added 09 May 2012 (Adasko)
6792 !c Intertyp means interaction type of backbone mainchain correlation:
6793 ! 1 = SC...Ca...Ca...Ca
6794 ! 2 = Ca...Ca...Ca...SC
6795 ! 3 = SC...Ca...Ca...SCi
6797 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
6798 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
6799 (itype(i-1,1).eq.ntyp1))) &
6800 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
6801 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
6802 .or.(itype(i,1).eq.ntyp1))) &
6803 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
6804 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
6805 (itype(i-3,1).eq.ntyp1)))) cycle
6806 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
6807 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
6809 do j=1,nterm_sccor(isccori,isccori1)
6810 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6811 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6812 cosphi=dcos(j*tauangle(intertyp,i))
6813 sinphi=dsin(j*tauangle(intertyp,i))
6814 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6815 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6816 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6818 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6819 'esccor',i,intertyp,esccor_ii
6820 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6821 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6823 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6824 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
6825 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6826 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6827 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6832 end subroutine eback_sc_corr
6833 !-----------------------------------------------------------------------------
6834 subroutine multibody(ecorr)
6835 ! This subroutine calculates multi-body contributions to energy following
6836 ! the idea of Skolnick et al. If side chains I and J make a contact and
6837 ! at the same time side chains I+1 and J+1 make a contact, an extra
6838 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6839 ! implicit real*8 (a-h,o-z)
6840 ! include 'DIMENSIONS'
6841 ! include 'COMMON.IOUNITS'
6842 ! include 'COMMON.DERIV'
6843 ! include 'COMMON.INTERACT'
6844 ! include 'COMMON.CONTACTS'
6845 real(kind=8),dimension(3) :: gx,gx1
6847 real(kind=8) :: ecorr
6848 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
6849 ! Set lprn=.true. for debugging
6853 write (iout,'(a)') 'Contact function values:'
6855 write (iout,'(i2,20(1x,i2,f10.5))') &
6856 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6861 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6862 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6874 num_conti=num_cont(i)
6875 num_conti1=num_cont(i1)
6880 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6881 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6882 !d & ' ishift=',ishift
6883 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6884 ! The system gains extra energy.
6885 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6886 endif ! j1==j+-ishift
6894 end subroutine multibody
6895 !-----------------------------------------------------------------------------
6896 real(kind=8) function esccorr(i,j,k,l,jj,kk)
6897 ! implicit real*8 (a-h,o-z)
6898 ! include 'DIMENSIONS'
6899 ! include 'COMMON.IOUNITS'
6900 ! include 'COMMON.DERIV'
6901 ! include 'COMMON.INTERACT'
6902 ! include 'COMMON.CONTACTS'
6903 real(kind=8),dimension(3) :: gx,gx1
6905 integer :: i,j,k,l,jj,kk,m,ll
6906 real(kind=8) :: eij,ekl
6910 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6911 ! Calculate the multi-body contribution to energy.
6912 ! Calculate multi-body contributions to the gradient.
6913 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6914 !d & k,l,(gacont(m,kk,k),m=1,3)
6916 gx(m) =ekl*gacont(m,jj,i)
6917 gx1(m)=eij*gacont(m,kk,k)
6918 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6919 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6920 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6921 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6925 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6930 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6935 end function esccorr
6936 !-----------------------------------------------------------------------------
6937 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6938 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6939 ! implicit real*8 (a-h,o-z)
6940 ! include 'DIMENSIONS'
6941 ! include 'COMMON.IOUNITS'
6944 ! integer :: maxconts !max_cont=maxconts =nres/4
6945 integer,parameter :: max_dim=26
6946 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6947 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6948 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6949 !el common /przechowalnia/ zapas
6950 integer :: status(MPI_STATUS_SIZE)
6951 integer,dimension((nres/4)*2) :: req !maxconts*2
6952 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
6954 ! include 'COMMON.SETUP'
6955 ! include 'COMMON.FFIELD'
6956 ! include 'COMMON.DERIV'
6957 ! include 'COMMON.INTERACT'
6958 ! include 'COMMON.CONTACTS'
6959 ! include 'COMMON.CONTROL'
6960 ! include 'COMMON.LOCAL'
6961 real(kind=8),dimension(3) :: gx,gx1
6962 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
6963 logical :: lprn,ldone
6965 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
6966 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
6968 ! Set lprn=.true. for debugging
6972 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6975 if (nfgtasks.le.1) goto 30
6977 write (iout,'(a)') 'Contact function values before RECEIVE:'
6979 write (iout,'(2i3,50(1x,i2,f5.2))') &
6980 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6985 do i=1,ntask_cont_from
6988 do i=1,ntask_cont_to
6991 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6993 ! Make the list of contacts to send to send to other procesors
6994 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6996 do i=iturn3_start,iturn3_end
6997 ! write (iout,*) "make contact list turn3",i," num_cont",
6999 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7001 do i=iturn4_start,iturn4_end
7002 ! write (iout,*) "make contact list turn4",i," num_cont",
7004 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7008 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7010 do j=1,num_cont_hb(i)
7013 iproc=iint_sent_local(k,jjc,ii)
7014 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7015 if (iproc.gt.0) then
7016 ncont_sent(iproc)=ncont_sent(iproc)+1
7017 nn=ncont_sent(iproc)
7019 zapas(2,nn,iproc)=jjc
7020 zapas(3,nn,iproc)=facont_hb(j,i)
7021 zapas(4,nn,iproc)=ees0p(j,i)
7022 zapas(5,nn,iproc)=ees0m(j,i)
7023 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7024 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7025 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7026 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7027 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7028 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7029 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7030 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7031 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7032 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7033 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7034 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7035 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7036 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7037 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7038 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7039 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7040 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7041 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7042 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7043 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7050 "Numbers of contacts to be sent to other processors",&
7051 (ncont_sent(i),i=1,ntask_cont_to)
7052 write (iout,*) "Contacts sent"
7053 do ii=1,ntask_cont_to
7055 iproc=itask_cont_to(ii)
7056 write (iout,*) nn," contacts to processor",iproc,&
7057 " of CONT_TO_COMM group"
7059 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7067 CorrelID1=nfgtasks+fg_rank+1
7069 ! Receive the numbers of needed contacts from other processors
7070 do ii=1,ntask_cont_from
7071 iproc=itask_cont_from(ii)
7073 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7074 FG_COMM,req(ireq),IERR)
7076 ! write (iout,*) "IRECV ended"
7078 ! Send the number of contacts needed by other processors
7079 do ii=1,ntask_cont_to
7080 iproc=itask_cont_to(ii)
7082 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7083 FG_COMM,req(ireq),IERR)
7085 ! write (iout,*) "ISEND ended"
7086 ! write (iout,*) "number of requests (nn)",ireq
7089 call MPI_Waitall(ireq,req,status_array,ierr)
7091 ! & "Numbers of contacts to be received from other processors",
7092 ! & (ncont_recv(i),i=1,ntask_cont_from)
7096 do ii=1,ntask_cont_from
7097 iproc=itask_cont_from(ii)
7099 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7100 ! & " of CONT_TO_COMM group"
7104 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7105 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7106 ! write (iout,*) "ireq,req",ireq,req(ireq)
7109 ! Send the contacts to processors that need them
7110 do ii=1,ntask_cont_to
7111 iproc=itask_cont_to(ii)
7113 ! write (iout,*) nn," contacts to processor",iproc,
7114 ! & " of CONT_TO_COMM group"
7117 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7118 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7119 ! write (iout,*) "ireq,req",ireq,req(ireq)
7121 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7125 ! write (iout,*) "number of requests (contacts)",ireq
7126 ! write (iout,*) "req",(req(i),i=1,4)
7129 call MPI_Waitall(ireq,req,status_array,ierr)
7130 do iii=1,ntask_cont_from
7131 iproc=itask_cont_from(iii)
7134 write (iout,*) "Received",nn," contacts from processor",iproc,&
7135 " of CONT_FROM_COMM group"
7138 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7143 ii=zapas_recv(1,i,iii)
7144 ! Flag the received contacts to prevent double-counting
7145 jj=-zapas_recv(2,i,iii)
7146 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7148 nnn=num_cont_hb(ii)+1
7151 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7152 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7153 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7154 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7155 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7156 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7157 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7158 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7159 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7160 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7161 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7162 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7163 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7164 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7165 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7166 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7167 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7168 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7169 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7170 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7171 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7172 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7173 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7174 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7179 write (iout,'(a)') 'Contact function values after receive:'
7181 write (iout,'(2i3,50(1x,i3,f5.2))') &
7182 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7190 write (iout,'(a)') 'Contact function values:'
7192 write (iout,'(2i3,50(1x,i3,f5.2))') &
7193 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7199 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7200 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7201 ! Remove the loop below after debugging !!!
7208 ! Calculate the local-electrostatic correlation terms
7209 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7211 num_conti=num_cont_hb(i)
7212 num_conti1=num_cont_hb(i+1)
7219 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7220 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7221 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7222 .or. j.lt.0 .and. j1.gt.0) .and. &
7223 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7224 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7225 ! The system gains extra energy.
7226 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7227 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7228 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7230 else if (j1.eq.j) then
7231 ! Contacts I-J and I-(J+1) occur simultaneously.
7232 ! The system loses extra energy.
7233 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7238 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7239 ! & ' jj=',jj,' kk=',kk
7241 ! Contacts I-J and (I+1)-J occur simultaneously.
7242 ! The system loses extra energy.
7243 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7249 end subroutine multibody_hb
7250 !-----------------------------------------------------------------------------
7251 subroutine add_hb_contact(ii,jj,itask)
7252 ! implicit real*8 (a-h,o-z)
7253 ! include "DIMENSIONS"
7254 ! include "COMMON.IOUNITS"
7255 ! include "COMMON.CONTACTS"
7256 ! integer,parameter :: maxconts=nres/4
7257 integer,parameter :: max_dim=26
7258 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7259 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7260 ! common /przechowalnia/ zapas
7261 integer :: i,j,ii,jj,iproc,nn,jjc
7262 integer,dimension(4) :: itask
7263 ! write (iout,*) "itask",itask
7266 if (iproc.gt.0) then
7267 do j=1,num_cont_hb(ii)
7269 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7271 ncont_sent(iproc)=ncont_sent(iproc)+1
7272 nn=ncont_sent(iproc)
7273 zapas(1,nn,iproc)=ii
7274 zapas(2,nn,iproc)=jjc
7275 zapas(3,nn,iproc)=facont_hb(j,ii)
7276 zapas(4,nn,iproc)=ees0p(j,ii)
7277 zapas(5,nn,iproc)=ees0m(j,ii)
7278 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7279 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7280 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7281 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7282 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7283 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7284 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7285 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7286 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7287 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7288 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7289 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7290 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7291 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7292 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7293 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7294 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7295 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7296 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7297 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7298 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7305 end subroutine add_hb_contact
7306 !-----------------------------------------------------------------------------
7307 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7308 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7309 ! implicit real*8 (a-h,o-z)
7310 ! include 'DIMENSIONS'
7311 ! include 'COMMON.IOUNITS'
7312 integer,parameter :: max_dim=70
7315 ! integer :: maxconts !max_cont=maxconts=nres/4
7316 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7317 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7318 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7319 ! common /przechowalnia/ zapas
7320 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7321 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7324 ! include 'COMMON.SETUP'
7325 ! include 'COMMON.FFIELD'
7326 ! include 'COMMON.DERIV'
7327 ! include 'COMMON.LOCAL'
7328 ! include 'COMMON.INTERACT'
7329 ! include 'COMMON.CONTACTS'
7330 ! include 'COMMON.CHAIN'
7331 ! include 'COMMON.CONTROL'
7332 real(kind=8),dimension(3) :: gx,gx1
7333 integer,dimension(nres) :: num_cont_hb_old
7334 logical :: lprn,ldone
7335 !EL double precision eello4,eello5,eelo6,eello_turn6
7336 !EL external eello4,eello5,eello6,eello_turn6
7338 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7339 j1,jp1,i1,num_conti1
7340 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7341 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7343 ! Set lprn=.true. for debugging
7348 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7350 num_cont_hb_old(i)=num_cont_hb(i)
7354 if (nfgtasks.le.1) goto 30
7356 write (iout,'(a)') 'Contact function values before RECEIVE:'
7358 write (iout,'(2i3,50(1x,i2,f5.2))') &
7359 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7364 do i=1,ntask_cont_from
7367 do i=1,ntask_cont_to
7370 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7372 ! Make the list of contacts to send to send to other procesors
7373 do i=iturn3_start,iturn3_end
7374 ! write (iout,*) "make contact list turn3",i," num_cont",
7376 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7378 do i=iturn4_start,iturn4_end
7379 ! write (iout,*) "make contact list turn4",i," num_cont",
7381 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7385 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7387 do j=1,num_cont_hb(i)
7390 iproc=iint_sent_local(k,jjc,ii)
7391 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7392 if (iproc.ne.0) then
7393 ncont_sent(iproc)=ncont_sent(iproc)+1
7394 nn=ncont_sent(iproc)
7396 zapas(2,nn,iproc)=jjc
7397 zapas(3,nn,iproc)=d_cont(j,i)
7401 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7406 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7414 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7425 "Numbers of contacts to be sent to other processors",&
7426 (ncont_sent(i),i=1,ntask_cont_to)
7427 write (iout,*) "Contacts sent"
7428 do ii=1,ntask_cont_to
7430 iproc=itask_cont_to(ii)
7431 write (iout,*) nn," contacts to processor",iproc,&
7432 " of CONT_TO_COMM group"
7434 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7442 CorrelID1=nfgtasks+fg_rank+1
7444 ! Receive the numbers of needed contacts from other processors
7445 do ii=1,ntask_cont_from
7446 iproc=itask_cont_from(ii)
7448 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7449 FG_COMM,req(ireq),IERR)
7451 ! write (iout,*) "IRECV ended"
7453 ! Send the number of contacts needed by other processors
7454 do ii=1,ntask_cont_to
7455 iproc=itask_cont_to(ii)
7457 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7458 FG_COMM,req(ireq),IERR)
7460 ! write (iout,*) "ISEND ended"
7461 ! write (iout,*) "number of requests (nn)",ireq
7464 call MPI_Waitall(ireq,req,status_array,ierr)
7466 ! & "Numbers of contacts to be received from other processors",
7467 ! & (ncont_recv(i),i=1,ntask_cont_from)
7471 do ii=1,ntask_cont_from
7472 iproc=itask_cont_from(ii)
7474 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7475 ! & " of CONT_TO_COMM group"
7479 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7480 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7481 ! write (iout,*) "ireq,req",ireq,req(ireq)
7484 ! Send the contacts to processors that need them
7485 do ii=1,ntask_cont_to
7486 iproc=itask_cont_to(ii)
7488 ! write (iout,*) nn," contacts to processor",iproc,
7489 ! & " of CONT_TO_COMM group"
7492 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7493 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7494 ! write (iout,*) "ireq,req",ireq,req(ireq)
7496 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7500 ! write (iout,*) "number of requests (contacts)",ireq
7501 ! write (iout,*) "req",(req(i),i=1,4)
7504 call MPI_Waitall(ireq,req,status_array,ierr)
7505 do iii=1,ntask_cont_from
7506 iproc=itask_cont_from(iii)
7509 write (iout,*) "Received",nn," contacts from processor",iproc,&
7510 " of CONT_FROM_COMM group"
7513 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7518 ii=zapas_recv(1,i,iii)
7519 ! Flag the received contacts to prevent double-counting
7520 jj=-zapas_recv(2,i,iii)
7521 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7523 nnn=num_cont_hb(ii)+1
7526 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7530 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7535 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7543 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7552 write (iout,'(a)') 'Contact function values after receive:'
7554 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7555 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7556 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7563 write (iout,'(a)') 'Contact function values:'
7565 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7566 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7567 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7574 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7575 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7576 ! Remove the loop below after debugging !!!
7583 ! Calculate the dipole-dipole interaction energies
7584 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7585 do i=iatel_s,iatel_e+1
7586 num_conti=num_cont_hb(i)
7595 ! Calculate the local-electrostatic correlation terms
7596 ! write (iout,*) "gradcorr5 in eello5 before loop"
7598 ! write (iout,'(i5,3f10.5)')
7599 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7601 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7602 ! write (iout,*) "corr loop i",i
7604 num_conti=num_cont_hb(i)
7605 num_conti1=num_cont_hb(i+1)
7612 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7613 ! & ' jj=',jj,' kk=',kk
7614 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7615 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7616 .or. j.lt.0 .and. j1.gt.0) .and. &
7617 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7618 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7619 ! The system gains extra energy.
7621 sqd1=dsqrt(d_cont(jj,i))
7622 sqd2=dsqrt(d_cont(kk,i1))
7623 sred_geom = sqd1*sqd2
7624 IF (sred_geom.lt.cutoff_corr) THEN
7625 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7627 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7628 !d & ' jj=',jj,' kk=',kk
7629 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7630 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7632 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7633 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7636 !d write (iout,*) 'sred_geom=',sred_geom,
7637 !d & ' ekont=',ekont,' fprim=',fprimcont,
7638 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7639 !d write (iout,*) "g_contij",g_contij
7640 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7641 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7642 call calc_eello(i,jp,i+1,jp1,jj,kk)
7643 if (wcorr4.gt.0.0d0) &
7644 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7645 if (energy_dec.and.wcorr4.gt.0.0d0) &
7646 write (iout,'(a6,4i5,0pf7.3)') &
7647 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7648 ! write (iout,*) "gradcorr5 before eello5"
7650 ! write (iout,'(i5,3f10.5)')
7651 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7653 if (wcorr5.gt.0.0d0) &
7654 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7655 ! write (iout,*) "gradcorr5 after eello5"
7657 ! write (iout,'(i5,3f10.5)')
7658 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7660 if (energy_dec.and.wcorr5.gt.0.0d0) &
7661 write (iout,'(a6,4i5,0pf7.3)') &
7662 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7663 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7664 !d write(2,*)'ijkl',i,jp,i+1,jp1
7665 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7666 .or. wturn6.eq.0.0d0))then
7667 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7668 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7669 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7670 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7671 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7672 !d & 'ecorr6=',ecorr6
7673 !d write (iout,'(4e15.5)') sred_geom,
7674 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7675 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7676 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7677 else if (wturn6.gt.0.0d0 &
7678 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7679 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7680 eturn6=eturn6+eello_turn6(i,jj,kk)
7681 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7682 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7683 !d write (2,*) 'multibody_eello:eturn6',eturn6
7692 num_cont_hb(i)=num_cont_hb_old(i)
7694 ! write (iout,*) "gradcorr5 in eello5"
7696 ! write (iout,'(i5,3f10.5)')
7697 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7700 end subroutine multibody_eello
7701 !-----------------------------------------------------------------------------
7702 subroutine add_hb_contact_eello(ii,jj,itask)
7703 ! implicit real*8 (a-h,o-z)
7704 ! include "DIMENSIONS"
7705 ! include "COMMON.IOUNITS"
7706 ! include "COMMON.CONTACTS"
7707 ! integer,parameter :: maxconts=nres/4
7708 integer,parameter :: max_dim=70
7709 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7710 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7711 ! common /przechowalnia/ zapas
7713 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7714 integer,dimension(4) ::itask
7715 ! write (iout,*) "itask",itask
7718 if (iproc.gt.0) then
7719 do j=1,num_cont_hb(ii)
7721 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7723 ncont_sent(iproc)=ncont_sent(iproc)+1
7724 nn=ncont_sent(iproc)
7725 zapas(1,nn,iproc)=ii
7726 zapas(2,nn,iproc)=jjc
7727 zapas(3,nn,iproc)=d_cont(j,ii)
7731 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7736 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7744 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7755 end subroutine add_hb_contact_eello
7756 !-----------------------------------------------------------------------------
7757 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7758 ! implicit real*8 (a-h,o-z)
7759 ! include 'DIMENSIONS'
7760 ! include 'COMMON.IOUNITS'
7761 ! include 'COMMON.DERIV'
7762 ! include 'COMMON.INTERACT'
7763 ! include 'COMMON.CONTACTS'
7764 real(kind=8),dimension(3) :: gx,gx1
7767 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7768 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7769 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7770 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
7781 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7782 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7783 ! Following 4 lines for diagnostics.
7788 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7789 ! & 'Contacts ',i,j,
7790 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7791 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7793 ! Calculate the multi-body contribution to energy.
7794 ! ecorr=ecorr+ekont*ees
7795 ! Calculate multi-body contributions to the gradient.
7796 coeffpees0pij=coeffp*ees0pij
7797 coeffmees0mij=coeffm*ees0mij
7798 coeffpees0pkl=coeffp*ees0pkl
7799 coeffmees0mkl=coeffm*ees0mkl
7801 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7802 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7803 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7804 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7805 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7806 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7807 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7808 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7809 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7810 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7811 coeffmees0mij*gacontm_hb1(ll,kk,k))
7812 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7813 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7814 coeffmees0mij*gacontm_hb2(ll,kk,k))
7815 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7816 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7817 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7818 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7819 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7820 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7821 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7822 coeffmees0mij*gacontm_hb3(ll,kk,k))
7823 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7824 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7825 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7830 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7831 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7832 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7833 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7838 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7839 !grad & ees*eij*gacont_hbr(ll,kk,k)-
7840 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7841 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7844 ! write (iout,*) "ehbcorr",ekont*ees
7846 if (shield_mode.gt.0) then
7849 !C print *,i,j,fac_shield(i),fac_shield(j),
7850 !C &fac_shield(k),fac_shield(l)
7851 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
7852 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7853 do ilist=1,ishield_list(i)
7854 iresshield=shield_list(ilist,i)
7856 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7857 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7859 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7860 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7864 do ilist=1,ishield_list(j)
7865 iresshield=shield_list(ilist,j)
7867 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7868 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7870 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7871 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7876 do ilist=1,ishield_list(k)
7877 iresshield=shield_list(ilist,k)
7879 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7880 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7882 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7883 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7887 do ilist=1,ishield_list(l)
7888 iresshield=shield_list(ilist,l)
7890 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7891 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7893 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7894 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7899 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
7900 grad_shield(m,i)*ehbcorr/fac_shield(i)
7901 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
7902 grad_shield(m,j)*ehbcorr/fac_shield(j)
7903 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
7904 grad_shield(m,i)*ehbcorr/fac_shield(i)
7905 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
7906 grad_shield(m,j)*ehbcorr/fac_shield(j)
7908 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
7909 grad_shield(m,k)*ehbcorr/fac_shield(k)
7910 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
7911 grad_shield(m,l)*ehbcorr/fac_shield(l)
7912 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
7913 grad_shield(m,k)*ehbcorr/fac_shield(k)
7914 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
7915 grad_shield(m,l)*ehbcorr/fac_shield(l)
7921 end function ehbcorr
7923 !-----------------------------------------------------------------------------
7924 subroutine dipole(i,j,jj)
7925 ! implicit real*8 (a-h,o-z)
7926 ! include 'DIMENSIONS'
7927 ! include 'COMMON.IOUNITS'
7928 ! include 'COMMON.CHAIN'
7929 ! include 'COMMON.FFIELD'
7930 ! include 'COMMON.DERIV'
7931 ! include 'COMMON.INTERACT'
7932 ! include 'COMMON.CONTACTS'
7933 ! include 'COMMON.TORSION'
7934 ! include 'COMMON.VAR'
7935 ! include 'COMMON.GEO'
7936 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
7937 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
7938 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
7940 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
7941 allocate(dipderx(3,5,4,maxconts,nres))
7944 iti1 = itortyp(itype(i+1,1))
7945 if (j.lt.nres-1) then
7946 itj1 = itortyp(itype(j+1,1))
7951 dipi(iii,1)=Ub2(iii,i)
7952 dipderi(iii)=Ub2der(iii,i)
7953 dipi(iii,2)=b1(iii,iti1)
7954 dipj(iii,1)=Ub2(iii,j)
7955 dipderj(iii)=Ub2der(iii,j)
7956 dipj(iii,2)=b1(iii,itj1)
7960 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7963 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7970 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
7974 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7979 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7980 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7982 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7984 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7986 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7989 end subroutine dipole
7991 !-----------------------------------------------------------------------------
7992 subroutine calc_eello(i,j,k,l,jj,kk)
7994 ! This subroutine computes matrices and vectors needed to calculate
7995 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
7998 ! implicit real*8 (a-h,o-z)
7999 ! include 'DIMENSIONS'
8000 ! include 'COMMON.IOUNITS'
8001 ! include 'COMMON.CHAIN'
8002 ! include 'COMMON.DERIV'
8003 ! include 'COMMON.INTERACT'
8004 ! include 'COMMON.CONTACTS'
8005 ! include 'COMMON.TORSION'
8006 ! include 'COMMON.VAR'
8007 ! include 'COMMON.GEO'
8008 ! include 'COMMON.FFIELD'
8009 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8010 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8011 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8014 !el common /kutas/ lprn
8015 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8016 !d & ' jj=',jj,' kk=',kk
8017 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8018 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8019 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8022 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8023 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8026 call transpose2(aa1(1,1),aa1t(1,1))
8027 call transpose2(aa2(1,1),aa2t(1,1))
8030 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8031 aa1tder(1,1,lll,kkk))
8032 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8033 aa2tder(1,1,lll,kkk))
8037 ! parallel orientation of the two CA-CA-CA frames.
8039 iti=itortyp(itype(i,1))
8043 itk1=itortyp(itype(k+1,1))
8044 itj=itortyp(itype(j,1))
8045 if (l.lt.nres-1) then
8046 itl1=itortyp(itype(l+1,1))
8050 ! A1 kernel(j+1) A2T
8052 !d write (iout,'(3f10.5,5x,3f10.5)')
8053 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8055 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8056 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8057 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8058 ! Following matrices are needed only for 6-th order cumulants
8059 IF (wcorr6.gt.0.0d0) THEN
8060 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8061 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8062 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8063 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8064 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8065 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8066 ADtEAderx(1,1,1,1,1,1))
8068 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8069 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8070 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8071 ADtEA1derx(1,1,1,1,1,1))
8073 ! End 6-th order cumulants
8076 !d write (2,*) 'In calc_eello6'
8078 !d write (2,*) 'iii=',iii
8080 !d write (2,*) 'kkk=',kkk
8082 !d write (2,'(3(2f10.5),5x)')
8083 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
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 ! A1T kernel(i+1) A2
8102 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8103 a_chuj_der(1,1,1,1,kk,k),1,.false.,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) THEN
8107 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8108 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8109 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8110 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8111 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8112 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8113 ADtEAderx(1,1,1,1,1,2))
8114 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8115 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8116 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8117 ADtEA1derx(1,1,1,1,1,2))
8119 ! End 6-th order cumulants
8120 call transpose2(EUgder(1,1,l),auxmat(1,1))
8121 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8122 call transpose2(EUg(1,1,l),auxmat(1,1))
8123 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8124 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8128 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8129 EAEAderx(1,1,lll,kkk,iii,2))
8134 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8135 ! They are needed only when the fifth- or the sixth-order cumulants are
8137 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8138 call transpose2(AEA(1,1,1),auxmat(1,1))
8139 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8140 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8141 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8142 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8143 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8144 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8145 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8146 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8147 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8148 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8149 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8150 call transpose2(AEA(1,1,2),auxmat(1,1))
8151 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8152 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8153 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8154 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8155 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8156 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8157 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8158 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8159 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8160 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8161 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8162 ! Calculate the Cartesian derivatives of the vectors.
8166 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8167 call matvec2(auxmat(1,1),b1(1,iti),&
8168 AEAb1derx(1,lll,kkk,iii,1,1))
8169 call matvec2(auxmat(1,1),Ub2(1,i),&
8170 AEAb2derx(1,lll,kkk,iii,1,1))
8171 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8172 AEAb1derx(1,lll,kkk,iii,2,1))
8173 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8174 AEAb2derx(1,lll,kkk,iii,2,1))
8175 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8176 call matvec2(auxmat(1,1),b1(1,itj),&
8177 AEAb1derx(1,lll,kkk,iii,1,2))
8178 call matvec2(auxmat(1,1),Ub2(1,j),&
8179 AEAb2derx(1,lll,kkk,iii,1,2))
8180 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8181 AEAb1derx(1,lll,kkk,iii,2,2))
8182 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8183 AEAb2derx(1,lll,kkk,iii,2,2))
8190 ! Antiparallel orientation of the two CA-CA-CA frames.
8192 iti=itortyp(itype(i,1))
8196 itk1=itortyp(itype(k+1,1))
8197 itl=itortyp(itype(l,1))
8198 itj=itortyp(itype(j,1))
8199 if (j.lt.nres-1) then
8200 itj1=itortyp(itype(j+1,1))
8204 ! A2 kernel(j-1)T A1T
8205 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8206 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8207 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8208 ! Following matrices are needed only for 6-th order cumulants
8209 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8210 j.eq.i+4 .and. l.eq.i+3)) THEN
8211 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8212 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8213 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8214 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8215 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8216 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8217 ADtEAderx(1,1,1,1,1,1))
8218 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8219 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8220 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8221 ADtEA1derx(1,1,1,1,1,1))
8223 ! End 6-th order cumulants
8224 call transpose2(EUgder(1,1,k),auxmat(1,1))
8225 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8226 call transpose2(EUg(1,1,k),auxmat(1,1))
8227 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8228 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8232 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8233 EAEAderx(1,1,lll,kkk,iii,1))
8237 ! A2T kernel(i+1)T A1
8238 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8239 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8240 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8241 ! Following matrices are needed only for 6-th order cumulants
8242 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8243 j.eq.i+4 .and. l.eq.i+3)) THEN
8244 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8245 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8246 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8247 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8248 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8249 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8250 ADtEAderx(1,1,1,1,1,2))
8251 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8252 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8253 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8254 ADtEA1derx(1,1,1,1,1,2))
8256 ! End 6-th order cumulants
8257 call transpose2(EUgder(1,1,j),auxmat(1,1))
8258 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8259 call transpose2(EUg(1,1,j),auxmat(1,1))
8260 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8261 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8265 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8266 EAEAderx(1,1,lll,kkk,iii,2))
8271 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8272 ! They are needed only when the fifth- or the sixth-order cumulants are
8274 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8275 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8276 call transpose2(AEA(1,1,1),auxmat(1,1))
8277 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8278 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8279 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8280 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8281 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8282 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8283 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8284 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8285 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8286 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8287 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8288 call transpose2(AEA(1,1,2),auxmat(1,1))
8289 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8290 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8291 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8292 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8293 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8294 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8295 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8296 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8297 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8298 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8299 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8300 ! Calculate the Cartesian derivatives of the vectors.
8304 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8305 call matvec2(auxmat(1,1),b1(1,iti),&
8306 AEAb1derx(1,lll,kkk,iii,1,1))
8307 call matvec2(auxmat(1,1),Ub2(1,i),&
8308 AEAb2derx(1,lll,kkk,iii,1,1))
8309 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8310 AEAb1derx(1,lll,kkk,iii,2,1))
8311 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8312 AEAb2derx(1,lll,kkk,iii,2,1))
8313 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8314 call matvec2(auxmat(1,1),b1(1,itl),&
8315 AEAb1derx(1,lll,kkk,iii,1,2))
8316 call matvec2(auxmat(1,1),Ub2(1,l),&
8317 AEAb2derx(1,lll,kkk,iii,1,2))
8318 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8319 AEAb1derx(1,lll,kkk,iii,2,2))
8320 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8321 AEAb2derx(1,lll,kkk,iii,2,2))
8329 end subroutine calc_eello
8330 !-----------------------------------------------------------------------------
8331 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8336 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8337 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8338 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8339 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8340 integer :: iii,kkk,lll
8343 !el common /kutas/ lprn
8344 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8346 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8349 !d if (lprn) write (2,*) 'In kernel'
8351 !d if (lprn) write (2,*) 'kkk=',kkk
8353 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8354 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8356 !d write (2,*) 'lll=',lll
8357 !d write (2,*) 'iii=1'
8359 !d write (2,'(3(2f10.5),5x)')
8360 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8363 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8364 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8366 !d write (2,*) 'lll=',lll
8367 !d write (2,*) 'iii=2'
8369 !d write (2,'(3(2f10.5),5x)')
8370 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8376 end subroutine kernel
8377 !-----------------------------------------------------------------------------
8378 real(kind=8) function eello4(i,j,k,l,jj,kk)
8379 ! implicit real*8 (a-h,o-z)
8380 ! include 'DIMENSIONS'
8381 ! include 'COMMON.IOUNITS'
8382 ! include 'COMMON.CHAIN'
8383 ! include 'COMMON.DERIV'
8384 ! include 'COMMON.INTERACT'
8385 ! include 'COMMON.CONTACTS'
8386 ! include 'COMMON.TORSION'
8387 ! include 'COMMON.VAR'
8388 ! include 'COMMON.GEO'
8389 real(kind=8),dimension(2,2) :: pizda
8390 real(kind=8),dimension(3) :: ggg1,ggg2
8391 real(kind=8) :: eel4,glongij,glongkl
8392 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8393 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8397 !d print *,'eello4:',i,j,k,l,jj,kk
8398 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8399 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8400 !old eij=facont_hb(jj,i)
8401 !old ekl=facont_hb(kk,k)
8403 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8404 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8405 gcorr_loc(k-1)=gcorr_loc(k-1) &
8406 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8408 gcorr_loc(l-1)=gcorr_loc(l-1) &
8409 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8411 gcorr_loc(j-1)=gcorr_loc(j-1) &
8412 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8417 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8418 -EAEAderx(2,2,lll,kkk,iii,1)
8419 !d derx(lll,kkk,iii)=0.0d0
8423 !d gcorr_loc(l-1)=0.0d0
8424 !d gcorr_loc(j-1)=0.0d0
8425 !d gcorr_loc(k-1)=0.0d0
8427 !d write (iout,*)'Contacts have occurred for peptide groups',
8428 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8429 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8430 if (j.lt.nres-1) then
8437 if (l.lt.nres-1) then
8445 !grad ggg1(ll)=eel4*g_contij(ll,1)
8446 !grad ggg2(ll)=eel4*g_contij(ll,2)
8447 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8448 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8449 !grad ghalf=0.5d0*ggg1(ll)
8450 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8451 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8452 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8453 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8454 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8455 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8456 !grad ghalf=0.5d0*ggg2(ll)
8457 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8458 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8459 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8460 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8461 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8462 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8466 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8471 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8476 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8481 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8485 !d write (2,*) iii,gcorr_loc(iii)
8488 !d write (2,*) 'ekont',ekont
8489 !d write (iout,*) 'eello4',ekont*eel4
8492 !-----------------------------------------------------------------------------
8493 real(kind=8) function eello5(i,j,k,l,jj,kk)
8494 ! implicit real*8 (a-h,o-z)
8495 ! include 'DIMENSIONS'
8496 ! include 'COMMON.IOUNITS'
8497 ! include 'COMMON.CHAIN'
8498 ! include 'COMMON.DERIV'
8499 ! include 'COMMON.INTERACT'
8500 ! include 'COMMON.CONTACTS'
8501 ! include 'COMMON.TORSION'
8502 ! include 'COMMON.VAR'
8503 ! include 'COMMON.GEO'
8504 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8505 real(kind=8),dimension(2) :: vv
8506 real(kind=8),dimension(3) :: ggg1,ggg2
8507 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8508 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8509 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8510 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8515 ! /l\ / \ \ / \ / \ / C
8516 ! / \ / \ \ / \ / \ / C
8517 ! j| o |l1 | o | o| o | | o |o C
8518 ! \ |/k\| |/ \| / |/ \| |/ \| C
8519 ! \i/ \ / \ / / \ / \ C
8521 ! (I) (II) (III) (IV) C
8523 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8525 ! Antiparallel chains C
8528 ! /j\ / \ \ / \ / \ / C
8529 ! / \ / \ \ / \ / \ / C
8530 ! j1| o |l | o | o| o | | o |o C
8531 ! \ |/k\| |/ \| / |/ \| |/ \| C
8532 ! \i/ \ / \ / / \ / \ C
8534 ! (I) (II) (III) (IV) C
8536 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8538 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8540 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8541 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8546 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8548 itk=itortyp(itype(k,1))
8549 itl=itortyp(itype(l,1))
8550 itj=itortyp(itype(j,1))
8555 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8556 !d & eel5_3_num,eel5_4_num)
8560 derx(lll,kkk,iii)=0.0d0
8564 !d eij=facont_hb(jj,i)
8565 !d ekl=facont_hb(kk,k)
8567 !d write (iout,*)'Contacts have occurred for peptide groups',
8568 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8570 ! Contribution from the graph I.
8571 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8572 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8573 call transpose2(EUg(1,1,k),auxmat(1,1))
8574 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8575 vv(1)=pizda(1,1)-pizda(2,2)
8576 vv(2)=pizda(1,2)+pizda(2,1)
8577 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8578 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8579 ! Explicit gradient in virtual-dihedral angles.
8580 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8581 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8582 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8583 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8584 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8585 vv(1)=pizda(1,1)-pizda(2,2)
8586 vv(2)=pizda(1,2)+pizda(2,1)
8587 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8588 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8589 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8590 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8591 vv(1)=pizda(1,1)-pizda(2,2)
8592 vv(2)=pizda(1,2)+pizda(2,1)
8594 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8595 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8596 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8598 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8599 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8600 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8602 ! Cartesian gradient
8606 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8608 vv(1)=pizda(1,1)-pizda(2,2)
8609 vv(2)=pizda(1,2)+pizda(2,1)
8610 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8611 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8612 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8618 ! Contribution from graph II
8619 call transpose2(EE(1,1,itk),auxmat(1,1))
8620 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8621 vv(1)=pizda(1,1)+pizda(2,2)
8622 vv(2)=pizda(2,1)-pizda(1,2)
8623 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8624 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8625 ! Explicit gradient in virtual-dihedral angles.
8626 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8627 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8628 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8629 vv(1)=pizda(1,1)+pizda(2,2)
8630 vv(2)=pizda(2,1)-pizda(1,2)
8632 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8633 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8634 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8636 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8637 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8638 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8640 ! Cartesian gradient
8644 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8646 vv(1)=pizda(1,1)+pizda(2,2)
8647 vv(2)=pizda(2,1)-pizda(1,2)
8648 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8649 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8650 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8658 ! Parallel orientation
8659 ! Contribution from graph III
8660 call transpose2(EUg(1,1,l),auxmat(1,1))
8661 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8662 vv(1)=pizda(1,1)-pizda(2,2)
8663 vv(2)=pizda(1,2)+pizda(2,1)
8664 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8665 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8666 ! Explicit gradient in virtual-dihedral angles.
8667 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8668 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8669 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8670 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8671 vv(1)=pizda(1,1)-pizda(2,2)
8672 vv(2)=pizda(1,2)+pizda(2,1)
8673 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8674 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8675 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8676 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8677 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8678 vv(1)=pizda(1,1)-pizda(2,2)
8679 vv(2)=pizda(1,2)+pizda(2,1)
8680 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8681 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8682 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8683 ! Cartesian gradient
8687 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8689 vv(1)=pizda(1,1)-pizda(2,2)
8690 vv(2)=pizda(1,2)+pizda(2,1)
8691 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8692 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8693 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8698 ! Contribution from graph IV
8700 call transpose2(EE(1,1,itl),auxmat(1,1))
8701 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8702 vv(1)=pizda(1,1)+pizda(2,2)
8703 vv(2)=pizda(2,1)-pizda(1,2)
8704 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8705 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8706 ! Explicit gradient in virtual-dihedral angles.
8707 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8708 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8709 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8710 vv(1)=pizda(1,1)+pizda(2,2)
8711 vv(2)=pizda(2,1)-pizda(1,2)
8712 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8713 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8714 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8715 ! Cartesian gradient
8719 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8721 vv(1)=pizda(1,1)+pizda(2,2)
8722 vv(2)=pizda(2,1)-pizda(1,2)
8723 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8724 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8725 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8730 ! Antiparallel orientation
8731 ! Contribution from graph III
8733 call transpose2(EUg(1,1,j),auxmat(1,1))
8734 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8735 vv(1)=pizda(1,1)-pizda(2,2)
8736 vv(2)=pizda(1,2)+pizda(2,1)
8737 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8738 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8739 ! Explicit gradient in virtual-dihedral angles.
8740 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8741 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8742 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8743 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8744 vv(1)=pizda(1,1)-pizda(2,2)
8745 vv(2)=pizda(1,2)+pizda(2,1)
8746 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8747 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8748 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8749 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8750 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8751 vv(1)=pizda(1,1)-pizda(2,2)
8752 vv(2)=pizda(1,2)+pizda(2,1)
8753 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8754 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8755 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8756 ! Cartesian gradient
8760 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8762 vv(1)=pizda(1,1)-pizda(2,2)
8763 vv(2)=pizda(1,2)+pizda(2,1)
8764 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8765 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8766 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8771 ! Contribution from graph IV
8773 call transpose2(EE(1,1,itj),auxmat(1,1))
8774 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8775 vv(1)=pizda(1,1)+pizda(2,2)
8776 vv(2)=pizda(2,1)-pizda(1,2)
8777 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
8778 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8779 ! Explicit gradient in virtual-dihedral angles.
8780 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8781 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8782 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8783 vv(1)=pizda(1,1)+pizda(2,2)
8784 vv(2)=pizda(2,1)-pizda(1,2)
8785 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8786 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
8787 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8788 ! Cartesian gradient
8792 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8794 vv(1)=pizda(1,1)+pizda(2,2)
8795 vv(2)=pizda(2,1)-pizda(1,2)
8796 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8797 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
8798 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8804 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8805 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8806 !d write (2,*) 'ijkl',i,j,k,l
8807 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8808 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
8810 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8811 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8812 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8813 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8814 if (j.lt.nres-1) then
8821 if (l.lt.nres-1) then
8831 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8832 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
8833 ! summed up outside the subrouine as for the other subroutines
8834 ! handling long-range interactions. The old code is commented out
8835 ! with "cgrad" to keep track of changes.
8837 !grad ggg1(ll)=eel5*g_contij(ll,1)
8838 !grad ggg2(ll)=eel5*g_contij(ll,2)
8839 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8840 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8841 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8842 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8843 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8844 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8845 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8846 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8848 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8849 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8850 !grad ghalf=0.5d0*ggg1(ll)
8852 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8853 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8854 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8855 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8856 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8857 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8858 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8859 !grad ghalf=0.5d0*ggg2(ll)
8861 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8862 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8863 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8864 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8865 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8866 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8871 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8872 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8877 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8878 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8884 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8889 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8893 !d write (2,*) iii,g_corr5_loc(iii)
8896 !d write (2,*) 'ekont',ekont
8897 !d write (iout,*) 'eello5',ekont*eel5
8900 !-----------------------------------------------------------------------------
8901 real(kind=8) function eello6(i,j,k,l,jj,kk)
8902 ! implicit real*8 (a-h,o-z)
8903 ! include 'DIMENSIONS'
8904 ! include 'COMMON.IOUNITS'
8905 ! include 'COMMON.CHAIN'
8906 ! include 'COMMON.DERIV'
8907 ! include 'COMMON.INTERACT'
8908 ! include 'COMMON.CONTACTS'
8909 ! include 'COMMON.TORSION'
8910 ! include 'COMMON.VAR'
8911 ! include 'COMMON.GEO'
8912 ! include 'COMMON.FFIELD'
8913 real(kind=8),dimension(3) :: ggg1,ggg2
8914 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
8916 real(kind=8) :: gradcorr6ij,gradcorr6kl
8917 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8918 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8923 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8931 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8932 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8936 derx(lll,kkk,iii)=0.0d0
8940 !d eij=facont_hb(jj,i)
8941 !d ekl=facont_hb(kk,k)
8947 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8948 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8949 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8950 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8951 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8952 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8954 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8955 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8956 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8957 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8958 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8959 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8963 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8965 ! If turn contributions are considered, they will be handled separately.
8966 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8967 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8968 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8969 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8970 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8971 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8972 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8974 if (j.lt.nres-1) then
8981 if (l.lt.nres-1) then
8989 !grad ggg1(ll)=eel6*g_contij(ll,1)
8990 !grad ggg2(ll)=eel6*g_contij(ll,2)
8991 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8992 !grad ghalf=0.5d0*ggg1(ll)
8994 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8995 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8996 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8997 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8998 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8999 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9000 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9001 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9002 !grad ghalf=0.5d0*ggg2(ll)
9003 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9005 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9006 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9007 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9008 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9009 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9010 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9015 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9016 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9021 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9022 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9028 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9033 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9037 !d write (2,*) iii,g_corr6_loc(iii)
9040 !d write (2,*) 'ekont',ekont
9041 !d write (iout,*) 'eello6',ekont*eel6
9044 !-----------------------------------------------------------------------------
9045 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9047 ! implicit real*8 (a-h,o-z)
9048 ! include 'DIMENSIONS'
9049 ! include 'COMMON.IOUNITS'
9050 ! include 'COMMON.CHAIN'
9051 ! include 'COMMON.DERIV'
9052 ! include 'COMMON.INTERACT'
9053 ! include 'COMMON.CONTACTS'
9054 ! include 'COMMON.TORSION'
9055 ! include 'COMMON.VAR'
9056 ! include 'COMMON.GEO'
9057 real(kind=8),dimension(2) :: vv,vv1
9058 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9061 !el common /kutas/ lprn
9062 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9063 real(kind=8) :: s1,s2,s3,s4,s5
9064 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9066 ! Parallel Antiparallel C
9072 ! \ j|/k\| / \ |/k\|l / C
9077 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9078 itk=itortyp(itype(k,1))
9079 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9080 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9081 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9082 call transpose2(EUgC(1,1,k),auxmat(1,1))
9083 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9084 vv1(1)=pizda1(1,1)-pizda1(2,2)
9085 vv1(2)=pizda1(1,2)+pizda1(2,1)
9086 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9087 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9088 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9089 s5=scalar2(vv(1),Dtobr2(1,i))
9090 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9091 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9092 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9093 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9094 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9095 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9096 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9097 +scalar2(vv(1),Dtobr2der(1,i)))
9098 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9099 vv1(1)=pizda1(1,1)-pizda1(2,2)
9100 vv1(2)=pizda1(1,2)+pizda1(2,1)
9101 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9102 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9104 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9105 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9106 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9107 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9108 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9110 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9111 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9112 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9113 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9114 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9116 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9117 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9118 vv1(1)=pizda1(1,1)-pizda1(2,2)
9119 vv1(2)=pizda1(1,2)+pizda1(2,1)
9120 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9121 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9122 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9123 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9132 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9133 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9134 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9135 call transpose2(EUgC(1,1,k),auxmat(1,1))
9136 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9138 vv1(1)=pizda1(1,1)-pizda1(2,2)
9139 vv1(2)=pizda1(1,2)+pizda1(2,1)
9140 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9141 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9142 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9143 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9144 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9145 s5=scalar2(vv(1),Dtobr2(1,i))
9146 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9151 end function eello6_graph1
9152 !-----------------------------------------------------------------------------
9153 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9155 ! implicit real*8 (a-h,o-z)
9156 ! include 'DIMENSIONS'
9157 ! include 'COMMON.IOUNITS'
9158 ! include 'COMMON.CHAIN'
9159 ! include 'COMMON.DERIV'
9160 ! include 'COMMON.INTERACT'
9161 ! include 'COMMON.CONTACTS'
9162 ! include 'COMMON.TORSION'
9163 ! include 'COMMON.VAR'
9164 ! include 'COMMON.GEO'
9166 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9167 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9169 !el common /kutas/ lprn
9170 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9171 real(kind=8) :: s2,s3,s4
9172 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9174 ! Parallel Antiparallel C
9180 ! \ j|/k\| \ |/k\|l C
9185 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9186 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9187 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9188 ! but not in a cluster cumulant
9190 s1=dip(1,jj,i)*dip(1,kk,k)
9192 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9193 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9194 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9195 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9196 call transpose2(EUg(1,1,k),auxmat(1,1))
9197 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9198 vv(1)=pizda(1,1)-pizda(2,2)
9199 vv(2)=pizda(1,2)+pizda(2,1)
9200 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9201 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9203 eello6_graph2=-(s1+s2+s3+s4)
9205 eello6_graph2=-(s2+s3+s4)
9208 ! Derivatives in gamma(i-1)
9211 s1=dipderg(1,jj,i)*dip(1,kk,k)
9213 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9214 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9215 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9216 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9218 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9220 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9222 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9224 ! Derivatives in gamma(k-1)
9226 s1=dip(1,jj,i)*dipderg(1,kk,k)
9228 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9229 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9230 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9231 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9232 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9233 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9234 vv(1)=pizda(1,1)-pizda(2,2)
9235 vv(2)=pizda(1,2)+pizda(2,1)
9236 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9238 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9240 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9242 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9243 ! Derivatives in gamma(j-1) or gamma(l-1)
9246 s1=dipderg(3,jj,i)*dip(1,kk,k)
9248 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9249 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9250 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9251 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9252 vv(1)=pizda(1,1)-pizda(2,2)
9253 vv(2)=pizda(1,2)+pizda(2,1)
9254 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9257 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9259 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9262 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9263 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9265 ! Derivatives in gamma(l-1) or gamma(j-1)
9268 s1=dip(1,jj,i)*dipderg(3,kk,k)
9270 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9271 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9272 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9273 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9274 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9275 vv(1)=pizda(1,1)-pizda(2,2)
9276 vv(2)=pizda(1,2)+pizda(2,1)
9277 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9280 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9282 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9285 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9286 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9288 ! Cartesian derivatives.
9290 write (2,*) 'In eello6_graph2'
9292 write (2,*) 'iii=',iii
9294 write (2,*) 'kkk=',kkk
9296 write (2,'(3(2f10.5),5x)') &
9297 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9307 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9309 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9312 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9315 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9317 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9318 call transpose2(EUg(1,1,k),auxmat(1,1))
9319 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9321 vv(1)=pizda(1,1)-pizda(2,2)
9322 vv(2)=pizda(1,2)+pizda(2,1)
9323 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9324 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9326 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9328 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9331 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9333 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9339 end function eello6_graph2
9340 !-----------------------------------------------------------------------------
9341 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9342 ! implicit real*8 (a-h,o-z)
9343 ! include 'DIMENSIONS'
9344 ! include 'COMMON.IOUNITS'
9345 ! include 'COMMON.CHAIN'
9346 ! include 'COMMON.DERIV'
9347 ! include 'COMMON.INTERACT'
9348 ! include 'COMMON.CONTACTS'
9349 ! include 'COMMON.TORSION'
9350 ! include 'COMMON.VAR'
9351 ! include 'COMMON.GEO'
9352 real(kind=8),dimension(2) :: vv,auxvec
9353 real(kind=8),dimension(2,2) :: pizda,auxmat
9355 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9356 real(kind=8) :: s1,s2,s3,s4
9357 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9359 ! Parallel Antiparallel C
9365 ! j|/k\| / |/k\|l / C
9370 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9372 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9373 ! energy moment and not to the cluster cumulant.
9374 iti=itortyp(itype(i,1))
9375 if (j.lt.nres-1) then
9376 itj1=itortyp(itype(j+1,1))
9380 itk=itortyp(itype(k,1))
9381 itk1=itortyp(itype(k+1,1))
9382 if (l.lt.nres-1) then
9383 itl1=itortyp(itype(l+1,1))
9388 s1=dip(4,jj,i)*dip(4,kk,k)
9390 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9391 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9392 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9393 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9394 call transpose2(EE(1,1,itk),auxmat(1,1))
9395 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9396 vv(1)=pizda(1,1)+pizda(2,2)
9397 vv(2)=pizda(2,1)-pizda(1,2)
9398 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9399 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9400 !d & "sum",-(s2+s3+s4)
9402 eello6_graph3=-(s1+s2+s3+s4)
9404 eello6_graph3=-(s2+s3+s4)
9407 ! Derivatives in gamma(k-1)
9408 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9409 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9410 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9411 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9412 ! Derivatives in gamma(l-1)
9413 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9414 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9415 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9416 vv(1)=pizda(1,1)+pizda(2,2)
9417 vv(2)=pizda(2,1)-pizda(1,2)
9418 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9419 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9420 ! Cartesian derivatives.
9426 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9428 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9431 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9433 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9434 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9436 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9437 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9439 vv(1)=pizda(1,1)+pizda(2,2)
9440 vv(2)=pizda(2,1)-pizda(1,2)
9441 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9443 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9445 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9448 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9450 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9452 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9457 end function eello6_graph3
9458 !-----------------------------------------------------------------------------
9459 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9460 ! implicit real*8 (a-h,o-z)
9461 ! include 'DIMENSIONS'
9462 ! include 'COMMON.IOUNITS'
9463 ! include 'COMMON.CHAIN'
9464 ! include 'COMMON.DERIV'
9465 ! include 'COMMON.INTERACT'
9466 ! include 'COMMON.CONTACTS'
9467 ! include 'COMMON.TORSION'
9468 ! include 'COMMON.VAR'
9469 ! include 'COMMON.GEO'
9470 ! include 'COMMON.FFIELD'
9471 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9472 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9474 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9476 real(kind=8) :: s1,s2,s3,s4
9477 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9479 ! Parallel Antiparallel C
9485 ! \ j|/k\| \ |/k\|l C
9490 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9492 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9493 ! energy moment and not to the cluster cumulant.
9494 !d write (2,*) 'eello_graph4: wturn6',wturn6
9495 iti=itortyp(itype(i,1))
9496 itj=itortyp(itype(j,1))
9497 if (j.lt.nres-1) then
9498 itj1=itortyp(itype(j+1,1))
9502 itk=itortyp(itype(k,1))
9503 if (k.lt.nres-1) then
9504 itk1=itortyp(itype(k+1,1))
9508 itl=itortyp(itype(l,1))
9509 if (l.lt.nres-1) then
9510 itl1=itortyp(itype(l+1,1))
9514 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9515 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9516 !d & ' itl',itl,' itl1',itl1
9519 s1=dip(3,jj,i)*dip(3,kk,k)
9521 s1=dip(2,jj,j)*dip(2,kk,l)
9524 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9525 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9527 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9528 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9530 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9531 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9533 call transpose2(EUg(1,1,k),auxmat(1,1))
9534 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9535 vv(1)=pizda(1,1)-pizda(2,2)
9536 vv(2)=pizda(2,1)+pizda(1,2)
9537 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9538 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9540 eello6_graph4=-(s1+s2+s3+s4)
9542 eello6_graph4=-(s2+s3+s4)
9544 ! Derivatives in gamma(i-1)
9548 s1=dipderg(2,jj,i)*dip(3,kk,k)
9550 s1=dipderg(4,jj,j)*dip(2,kk,l)
9553 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9555 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9556 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9558 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9559 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9561 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9562 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9563 !d write (2,*) 'turn6 derivatives'
9565 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9567 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9571 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9573 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9577 ! Derivatives in gamma(k-1)
9580 s1=dip(3,jj,i)*dipderg(2,kk,k)
9582 s1=dip(2,jj,j)*dipderg(4,kk,l)
9585 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9586 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9588 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9589 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9591 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9592 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9594 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9595 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9596 vv(1)=pizda(1,1)-pizda(2,2)
9597 vv(2)=pizda(2,1)+pizda(1,2)
9598 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9599 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9601 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9603 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9607 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9609 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9612 ! Derivatives in gamma(j-1) or gamma(l-1)
9613 if (l.eq.j+1 .and. l.gt.1) then
9614 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9615 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9616 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9617 vv(1)=pizda(1,1)-pizda(2,2)
9618 vv(2)=pizda(2,1)+pizda(1,2)
9619 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9620 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9621 else if (j.gt.1) then
9622 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9623 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9624 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9625 vv(1)=pizda(1,1)-pizda(2,2)
9626 vv(2)=pizda(2,1)+pizda(1,2)
9627 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9628 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9629 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9631 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9634 ! Cartesian derivatives.
9641 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9643 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9647 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9649 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9653 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9655 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9657 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9658 b1(1,itj1),auxvec(1))
9659 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9661 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9662 b1(1,itl1),auxvec(1))
9663 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9665 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9667 vv(1)=pizda(1,1)-pizda(2,2)
9668 vv(2)=pizda(2,1)+pizda(1,2)
9669 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9671 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9673 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9676 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9679 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9682 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9684 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9686 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9692 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9695 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9697 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9704 end function eello6_graph4
9705 !-----------------------------------------------------------------------------
9706 real(kind=8) function eello_turn6(i,jj,kk)
9707 ! implicit real*8 (a-h,o-z)
9708 ! include 'DIMENSIONS'
9709 ! include 'COMMON.IOUNITS'
9710 ! include 'COMMON.CHAIN'
9711 ! include 'COMMON.DERIV'
9712 ! include 'COMMON.INTERACT'
9713 ! include 'COMMON.CONTACTS'
9714 ! include 'COMMON.TORSION'
9715 ! include 'COMMON.VAR'
9716 ! include 'COMMON.GEO'
9717 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9718 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9719 real(kind=8),dimension(3) :: ggg1,ggg2
9720 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9721 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9722 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9723 ! the respective energy moment and not to the cluster cumulant.
9725 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9726 integer :: j1,j2,l1,l2,ll
9727 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9728 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9737 iti=itortyp(itype(i,1))
9738 itk=itortyp(itype(k,1))
9739 itk1=itortyp(itype(k+1,1))
9740 itl=itortyp(itype(l,1))
9741 itj=itortyp(itype(j,1))
9742 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9743 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9744 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9749 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9751 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9755 derx_turn(lll,kkk,iii)=0.0d0
9762 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9764 !d write (2,*) 'eello6_5',eello6_5
9766 call transpose2(AEA(1,1,1),auxmat(1,1))
9767 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9768 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9769 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9771 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9772 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9773 s2 = scalar2(b1(1,itk),vtemp1(1))
9775 call transpose2(AEA(1,1,2),atemp(1,1))
9776 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9777 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9778 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9780 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9781 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9782 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9784 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9785 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9786 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9787 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9788 ss13 = scalar2(b1(1,itk),vtemp4(1))
9789 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9791 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9797 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9798 ! Derivatives in gamma(i+2)
9802 call transpose2(AEA(1,1,1),auxmatd(1,1))
9803 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9804 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9805 call transpose2(AEAderg(1,1,2),atempd(1,1))
9806 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9807 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9809 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9810 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9811 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9817 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9818 ! Derivatives in gamma(i+3)
9820 call transpose2(AEA(1,1,1),auxmatd(1,1))
9821 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9822 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9823 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9825 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9826 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9827 s2d = scalar2(b1(1,itk),vtemp1d(1))
9829 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9830 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9832 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9834 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9835 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9836 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9844 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9845 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9847 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9848 -0.5d0*ekont*(s2d+s12d)
9850 ! Derivatives in gamma(i+4)
9851 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9852 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9853 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9855 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9856 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9857 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9865 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9867 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9869 ! Derivatives in gamma(i+5)
9871 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9872 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9873 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9875 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9876 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9877 s2d = scalar2(b1(1,itk),vtemp1d(1))
9879 call transpose2(AEA(1,1,2),atempd(1,1))
9880 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9881 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9883 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9884 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9886 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9887 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9888 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9896 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9897 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9899 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9900 -0.5d0*ekont*(s2d+s12d)
9902 ! Cartesian derivatives
9907 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9908 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9909 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9911 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9912 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
9914 s2d = scalar2(b1(1,itk),vtemp1d(1))
9916 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9917 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9918 s8d = -(atempd(1,1)+atempd(2,2))* &
9919 scalar2(cc(1,1,itl),vtemp2(1))
9921 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
9923 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9924 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9931 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9934 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9938 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9941 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9950 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
9952 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9953 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9954 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9955 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9956 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
9958 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9959 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9960 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9964 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9965 !d & 16*eel_turn6_num
9967 if (j.lt.nres-1) then
9974 if (l.lt.nres-1) then
9982 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
9983 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
9984 !grad ghalf=0.5d0*ggg1(ll)
9986 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9987 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9988 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
9989 +ekont*derx_turn(ll,2,1)
9990 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9991 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
9992 +ekont*derx_turn(ll,4,1)
9993 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9994 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9995 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9996 !grad ghalf=0.5d0*ggg2(ll)
9998 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
9999 +ekont*derx_turn(ll,2,2)
10000 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10001 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10002 +ekont*derx_turn(ll,4,2)
10003 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10004 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10005 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10010 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10015 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10021 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10026 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10030 !d write (2,*) iii,g_corr6_loc(iii)
10032 eello_turn6=ekont*eel_turn6
10033 !d write (2,*) 'ekont',ekont
10034 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10036 end function eello_turn6
10037 !-----------------------------------------------------------------------------
10038 subroutine MATVEC2(A1,V1,V2)
10039 !DIR$ INLINEALWAYS MATVEC2
10041 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10043 ! implicit real*8 (a-h,o-z)
10044 ! include 'DIMENSIONS'
10045 real(kind=8),dimension(2) :: V1,V2
10046 real(kind=8),dimension(2,2) :: A1
10047 real(kind=8) :: vaux1,vaux2
10051 ! 3 VI=VI+A1(I,K)*V1(K)
10055 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10056 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10060 end subroutine MATVEC2
10061 !-----------------------------------------------------------------------------
10062 subroutine MATMAT2(A1,A2,A3)
10064 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10066 ! implicit real*8 (a-h,o-z)
10067 ! include 'DIMENSIONS'
10068 real(kind=8),dimension(2,2) :: A1,A2,A3
10069 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10070 ! DIMENSION AI3(2,2)
10074 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10080 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10081 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10082 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10083 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10089 end subroutine MATMAT2
10090 !-----------------------------------------------------------------------------
10091 real(kind=8) function scalar2(u,v)
10092 !DIR$ INLINEALWAYS scalar2
10094 real(kind=8),dimension(2) :: u,v
10097 scalar2=u(1)*v(1)+u(2)*v(2)
10099 end function scalar2
10100 !-----------------------------------------------------------------------------
10101 subroutine transpose2(a,at)
10102 !DIR$ INLINEALWAYS transpose2
10104 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10107 real(kind=8),dimension(2,2) :: a,at
10113 end subroutine transpose2
10114 !-----------------------------------------------------------------------------
10115 subroutine transpose(n,a,at)
10118 real(kind=8),dimension(n,n) :: a,at
10125 end subroutine transpose
10126 !-----------------------------------------------------------------------------
10127 subroutine prodmat3(a1,a2,kk,transp,prod)
10128 !DIR$ INLINEALWAYS prodmat3
10130 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10134 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10136 !rc double precision auxmat(2,2),prod_(2,2)
10139 !rc call transpose2(kk(1,1),auxmat(1,1))
10140 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10141 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10143 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10144 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10145 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10146 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10147 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10148 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10149 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10150 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10153 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10154 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10156 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10157 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10158 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10159 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10160 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10161 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10162 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10163 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10166 ! call transpose2(a2(1,1),a2t(1,1))
10169 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10170 !rc print *,((prod(i,j),i=1,2),j=1,2)
10173 end subroutine prodmat3
10174 !-----------------------------------------------------------------------------
10175 ! energy_p_new_barrier.F
10176 !-----------------------------------------------------------------------------
10177 subroutine sum_gradient
10178 ! implicit real*8 (a-h,o-z)
10179 use io_base, only: pdbout
10180 ! include 'DIMENSIONS'
10184 !MS$ATTRIBUTES C :: proc_proc
10190 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10191 gloc_scbuf !(3,maxres)
10193 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10195 !el local variables
10196 integer :: i,j,k,ierror,ierr
10197 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10198 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10199 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10200 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10201 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10202 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10203 gsccorr_max,gsccorrx_max,time00
10205 ! include 'COMMON.SETUP'
10206 ! include 'COMMON.IOUNITS'
10207 ! include 'COMMON.FFIELD'
10208 ! include 'COMMON.DERIV'
10209 ! include 'COMMON.INTERACT'
10210 ! include 'COMMON.SBRIDGE'
10211 ! include 'COMMON.CHAIN'
10212 ! include 'COMMON.VAR'
10213 ! include 'COMMON.CONTROL'
10214 ! include 'COMMON.TIME1'
10215 ! include 'COMMON.MAXGRAD'
10216 ! include 'COMMON.SCCOR'
10221 write (iout,*) "sum_gradient gvdwc, gvdwx"
10223 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10224 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10234 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10235 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10236 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10239 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10240 ! in virtual-bond-vector coordinates
10243 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10245 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10246 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10248 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10250 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10251 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10253 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10255 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10256 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10257 (gvdwc_scpp(j,i),j=1,3)
10259 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10261 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10262 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10263 (gelc_loc_long(j,i),j=1,3)
10270 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10271 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10272 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10273 wel_loc*gel_loc_long(j,i)+ &
10274 wcorr*gradcorr_long(j,i)+ &
10275 wcorr5*gradcorr5_long(j,i)+ &
10276 wcorr6*gradcorr6_long(j,i)+ &
10277 wturn6*gcorr6_turn_long(j,i)+ &
10278 wstrain*ghpbc(j,i) &
10279 +wliptran*gliptranc(j,i) &
10281 +welec*gshieldc(j,i) &
10282 +wcorr*gshieldc_ec(j,i) &
10283 +wturn3*gshieldc_t3(j,i)&
10284 +wturn4*gshieldc_t4(j,i)&
10285 +wel_loc*gshieldc_ll(j,i)&
10286 +wtube*gg_tube(j,i)
10295 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10296 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10297 welec*gelc_long(j,i)+ &
10298 wbond*gradb(j,i)+ &
10299 wel_loc*gel_loc_long(j,i)+ &
10300 wcorr*gradcorr_long(j,i)+ &
10301 wcorr5*gradcorr5_long(j,i)+ &
10302 wcorr6*gradcorr6_long(j,i)+ &
10303 wturn6*gcorr6_turn_long(j,i)+ &
10304 wstrain*ghpbc(j,i) &
10305 +wliptran*gliptranc(j,i) &
10307 +welec*gshieldc(j,i)&
10308 +wcorr*gshieldc_ec(j,i) &
10309 +wturn4*gshieldc_t4(j,i) &
10310 +wel_loc*gshieldc_ll(j,i)&
10311 +wtube*gg_tube(j,i)
10319 if (nfgtasks.gt.1) then
10322 write (iout,*) "gradbufc before allreduce"
10324 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10330 gradbufc_sum(j,i)=gradbufc(j,i)
10333 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10334 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10335 ! time_reduce=time_reduce+MPI_Wtime()-time00
10337 ! write (iout,*) "gradbufc_sum after allreduce"
10339 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10344 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10348 gradbufc(k,i)=0.0d0
10352 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10353 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10354 " jgrad_end ",jgrad_end(i),&
10355 i=igrad_start,igrad_end)
10358 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10359 ! do not parallelize this part.
10361 ! do i=igrad_start,igrad_end
10362 ! do j=jgrad_start(i),jgrad_end(i)
10364 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10369 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10373 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10377 write (iout,*) "gradbufc after summing"
10379 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10387 write (iout,*) "gradbufc"
10389 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10396 gradbufc_sum(j,i)=gradbufc(j,i)
10397 gradbufc(j,i)=0.0d0
10401 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10405 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10410 ! gradbufc(k,i)=0.0d0
10414 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10420 write (iout,*) "gradbufc after summing"
10422 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10431 gradbufc(k,nres)=0.0d0
10433 !el----------------
10434 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10435 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10436 !el-----------------
10440 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10441 wel_loc*gel_loc(j,i)+ &
10442 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10443 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10444 wel_loc*gel_loc_long(j,i)+ &
10445 wcorr*gradcorr_long(j,i)+ &
10446 wcorr5*gradcorr5_long(j,i)+ &
10447 wcorr6*gradcorr6_long(j,i)+ &
10448 wturn6*gcorr6_turn_long(j,i))+ &
10449 wbond*gradb(j,i)+ &
10450 wcorr*gradcorr(j,i)+ &
10451 wturn3*gcorr3_turn(j,i)+ &
10452 wturn4*gcorr4_turn(j,i)+ &
10453 wcorr5*gradcorr5(j,i)+ &
10454 wcorr6*gradcorr6(j,i)+ &
10455 wturn6*gcorr6_turn(j,i)+ &
10456 wsccor*gsccorc(j,i) &
10457 +wscloc*gscloc(j,i) &
10458 +wliptran*gliptranc(j,i) &
10460 +welec*gshieldc(j,i) &
10461 +welec*gshieldc_loc(j,i) &
10462 +wcorr*gshieldc_ec(j,i) &
10463 +wcorr*gshieldc_loc_ec(j,i) &
10464 +wturn3*gshieldc_t3(j,i) &
10465 +wturn3*gshieldc_loc_t3(j,i) &
10466 +wturn4*gshieldc_t4(j,i) &
10467 +wturn4*gshieldc_loc_t4(j,i) &
10468 +wel_loc*gshieldc_ll(j,i) &
10469 +wel_loc*gshieldc_loc_ll(j,i) &
10470 +wtube*gg_tube(j,i)
10474 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10475 wel_loc*gel_loc(j,i)+ &
10476 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10477 welec*gelc_long(j,i)+ &
10478 wel_loc*gel_loc_long(j,i)+ &
10479 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10480 wcorr5*gradcorr5_long(j,i)+ &
10481 wcorr6*gradcorr6_long(j,i)+ &
10482 wturn6*gcorr6_turn_long(j,i))+ &
10483 wbond*gradb(j,i)+ &
10484 wcorr*gradcorr(j,i)+ &
10485 wturn3*gcorr3_turn(j,i)+ &
10486 wturn4*gcorr4_turn(j,i)+ &
10487 wcorr5*gradcorr5(j,i)+ &
10488 wcorr6*gradcorr6(j,i)+ &
10489 wturn6*gcorr6_turn(j,i)+ &
10490 wsccor*gsccorc(j,i) &
10491 +wscloc*gscloc(j,i) &
10493 +wliptran*gliptranc(j,i) &
10494 +welec*gshieldc(j,i) &
10495 +welec*gshieldc_loc(j,) &
10496 +wcorr*gshieldc_ec(j,i) &
10497 +wcorr*gshieldc_loc_ec(j,i) &
10498 +wturn3*gshieldc_t3(j,i) &
10499 +wturn3*gshieldc_loc_t3(j,i) &
10500 +wturn4*gshieldc_t4(j,i) &
10501 +wturn4*gshieldc_loc_t4(j,i) &
10502 +wel_loc*gshieldc_ll(j,i) &
10503 +wel_loc*gshieldc_loc_ll(j,i) &
10504 +wtube*gg_tube(j,i)
10509 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10510 wbond*gradbx(j,i)+ &
10511 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10512 wsccor*gsccorx(j,i) &
10513 +wscloc*gsclocx(j,i) &
10514 +wliptran*gliptranx(j,i) &
10515 +welec*gshieldx(j,i) &
10516 +wcorr*gshieldx_ec(j,i) &
10517 +wturn3*gshieldx_t3(j,i) &
10518 +wturn4*gshieldx_t4(j,i) &
10519 +wel_loc*gshieldx_ll(j,i)&
10520 +wtube*gg_tube_sc(j,i)
10526 write (iout,*) "gloc before adding corr"
10528 write (iout,*) i,gloc(i,icg)
10532 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10533 +wcorr5*g_corr5_loc(i) &
10534 +wcorr6*g_corr6_loc(i) &
10535 +wturn4*gel_loc_turn4(i) &
10536 +wturn3*gel_loc_turn3(i) &
10537 +wturn6*gel_loc_turn6(i) &
10538 +wel_loc*gel_loc_loc(i)
10541 write (iout,*) "gloc after adding corr"
10543 write (iout,*) i,gloc(i,icg)
10547 if (nfgtasks.gt.1) then
10550 gradbufc(j,i)=gradc(j,i,icg)
10551 gradbufx(j,i)=gradx(j,i,icg)
10555 glocbuf(i)=gloc(i,icg)
10559 write (iout,*) "gloc_sc before reduce"
10562 write (iout,*) i,j,gloc_sc(j,i,icg)
10569 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10573 call MPI_Barrier(FG_COMM,IERR)
10574 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10576 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10577 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10578 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
10579 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10580 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10581 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10582 time_reduce=time_reduce+MPI_Wtime()-time00
10583 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10584 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10585 time_reduce=time_reduce+MPI_Wtime()-time00
10588 write (iout,*) "gloc_sc after reduce"
10591 write (iout,*) i,j,gloc_sc(j,i,icg)
10597 write (iout,*) "gloc after reduce"
10599 write (iout,*) i,gloc(i,icg)
10604 if (gnorm_check) then
10606 ! Compute the maximum elements of the gradient
10609 gvdwc_scp_max=0.0d0
10616 gcorr3_turn_max=0.0d0
10617 gcorr4_turn_max=0.0d0
10618 gradcorr5_max=0.0d0
10619 gradcorr6_max=0.0d0
10620 gcorr6_turn_max=0.0d0
10624 gradx_scp_max=0.0d0
10630 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10631 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10632 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10633 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10634 gvdwc_scp_max=gvdwc_scp_norm
10635 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10636 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10637 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10638 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10639 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10640 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10641 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10642 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10643 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10644 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10645 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10646 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10647 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10649 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10650 gcorr3_turn_max=gcorr3_turn_norm
10651 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10653 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10654 gcorr4_turn_max=gcorr4_turn_norm
10655 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10656 if (gradcorr5_norm.gt.gradcorr5_max) &
10657 gradcorr5_max=gradcorr5_norm
10658 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10659 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10660 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10662 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10663 gcorr6_turn_max=gcorr6_turn_norm
10664 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10665 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10666 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10667 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10668 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10669 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10670 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10671 if (gradx_scp_norm.gt.gradx_scp_max) &
10672 gradx_scp_max=gradx_scp_norm
10673 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10674 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10675 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10676 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10677 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10678 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10679 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10680 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10684 open(istat,file=statname,position="append")
10686 open(istat,file=statname,access="append")
10688 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10689 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10690 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
10691 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
10692 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
10693 gsccorx_max,gsclocx_max
10695 if (gvdwc_max.gt.1.0d4) then
10696 write (iout,*) "gvdwc gvdwx gradb gradbx"
10698 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
10699 gradb(j,i),gradbx(j,i),j=1,3)
10701 call pdbout(0.0d0,'cipiszcze',iout)
10708 write (iout,*) "gradc gradx gloc"
10710 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
10711 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
10716 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
10719 end subroutine sum_gradient
10720 !-----------------------------------------------------------------------------
10722 ! implicit real*8 (a-h,o-z)
10724 ! include 'DIMENSIONS'
10725 ! include 'COMMON.CHAIN'
10726 ! include 'COMMON.DERIV'
10727 ! include 'COMMON.CALC'
10728 ! include 'COMMON.IOUNITS'
10729 real(kind=8), dimension(3) :: dcosom1,dcosom2
10731 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
10732 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
10733 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
10734 -2.0D0*alf12*eps3der+sigder*sigsq_om12
10738 ! eom12=evdwij*eps1_om12
10740 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
10742 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
10743 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
10744 !C print *,sss_ele_cut,'in sc_grad'
10746 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
10747 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
10750 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
10751 !C print *,'gg',k,gg(k)
10753 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
10754 ! write (iout,*) "gg",(gg(k),k=1,3)
10756 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
10757 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10758 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
10761 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
10762 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10763 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
10766 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10767 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
10768 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10769 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
10772 ! Calculate the components of the gradient in DC and X
10776 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
10780 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
10781 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
10784 end subroutine sc_grad
10786 !-----------------------------------------------------------------------------
10787 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
10790 ! implicit real*8 (a-h,o-z)
10791 ! include 'DIMENSIONS'
10792 ! include 'COMMON.LOCAL'
10793 ! include 'COMMON.IOUNITS'
10794 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
10795 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10796 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
10797 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
10798 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
10800 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
10801 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10802 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
10803 !el local variables
10805 delthec=thetai-thet_pred_mean
10806 delthe0=thetai-theta0i
10807 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
10808 t3 = thetai-thet_pred_mean
10812 t14 = t12+t6*sigsqtc
10814 t21 = thetai-theta0i
10820 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
10821 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
10822 *(-t12*t9-ak*sig0inv*t27)
10824 end subroutine mixder
10826 !-----------------------------------------------------------------------------
10828 !-----------------------------------------------------------------------------
10830 !-----------------------------------------------------------------------------
10831 ! This subroutine calculates the derivatives of the consecutive virtual
10832 ! bond vectors and the SC vectors in the virtual-bond angles theta and
10833 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
10834 ! in the angles alpha and omega, describing the location of a side chain
10835 ! in its local coordinate system.
10837 ! The derivatives are stored in the following arrays:
10839 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
10840 ! The structure is as follows:
10842 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
10843 ! 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)
10844 ! . . . . . . . . . . . . . . . . . .
10845 ! 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)
10849 ! 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)
10851 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
10852 ! The structure is same as above.
10854 ! DCDS - the derivatives of the side chain vectors in the local spherical
10855 ! andgles alph and omega:
10857 ! 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)
10858 ! 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)
10862 ! 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)
10864 ! Version of March '95, based on an early version of November '91.
10866 !**********************************************************************
10867 ! implicit real*8 (a-h,o-z)
10868 ! include 'DIMENSIONS'
10869 ! include 'COMMON.VAR'
10870 ! include 'COMMON.CHAIN'
10871 ! include 'COMMON.DERIV'
10872 ! include 'COMMON.GEO'
10873 ! include 'COMMON.LOCAL'
10874 ! include 'COMMON.INTERACT'
10875 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
10876 real(kind=8),dimension(3,3) :: dp,temp
10877 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
10878 real(kind=8),dimension(3) :: xx,xx1
10879 !el local variables
10880 integer :: i,k,l,j,m,ind,ind1,jjj
10881 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
10882 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
10883 sint2,xp,yp,xxp,yyp,zzp,dj
10885 ! common /przechowalnia/ fromto
10886 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
10887 ! get the position of the jth ijth fragment of the chain coordinate system
10888 ! in the fromto array.
10889 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10891 ! maxdim=(nres-1)*(nres-2)/2
10892 ! allocate(dcdv(6,maxdim),dxds(6,nres))
10893 ! calculate the derivatives of transformation matrix elements in theta
10896 !el call flush(iout) !el
10898 rdt(1,1,i)=-rt(1,2,i)
10899 rdt(1,2,i)= rt(1,1,i)
10901 rdt(2,1,i)=-rt(2,2,i)
10902 rdt(2,2,i)= rt(2,1,i)
10904 rdt(3,1,i)=-rt(3,2,i)
10905 rdt(3,2,i)= rt(3,1,i)
10909 ! derivatives in phi
10915 drt(2,1,i)= rt(3,1,i)
10916 drt(2,2,i)= rt(3,2,i)
10917 drt(2,3,i)= rt(3,3,i)
10918 drt(3,1,i)=-rt(2,1,i)
10919 drt(3,2,i)=-rt(2,2,i)
10920 drt(3,3,i)=-rt(2,3,i)
10923 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
10929 temp(k,l)=rt(k,l,i)
10934 fromto(k,l,ind)=temp(k,l)
10943 dpkl=dpkl+temp(k,m)*rt(m,l,j)
10946 fromto(k,l,ind)=dpkl
10957 ! Calculate derivatives.
10963 ! Derivatives of DC(i+1) in theta(i+2)
10969 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
10972 prordt(j,k,i)=dp(j,k)
10975 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
10978 ! Derivatives of SC(i+1) in theta(i+2)
10980 xx1(1)=-0.5D0*xloc(2,i+1)
10981 xx1(2)= 0.5D0*xloc(1,i+1)
10985 xj=xj+r(j,k,i)*xx1(k)
10992 rj=rj+prod(j,k,i)*xx(k)
10997 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
10998 ! than the other off-diagonal derivatives.
11003 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11005 dxdv(j,ind1+1)=dxoiij
11007 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11009 ! Derivatives of DC(i+1) in phi(i+2)
11015 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11018 prodrt(j,k,i)=dp(j,k)
11020 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11023 ! Derivatives of SC(i+1) in phi(i+2)
11026 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11027 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11031 rj=rj+prod(j,k,i)*xx(k)
11036 ! Derivatives of SC(i+1) in phi(i+3).
11041 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11043 dxdv(j+3,ind1+1)=dxoiij
11046 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11047 ! theta(nres) and phi(i+3) thru phi(nres).
11051 ind=indmat(i+1,j+1)
11052 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11057 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11062 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11063 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11064 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11065 ! Derivatives of virtual-bond vectors in theta
11067 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11069 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11070 ! Derivatives of SC vectors in theta
11074 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11076 dxdv(k,ind1+1)=dxoijk
11079 !--- Calculate the derivatives in phi
11085 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11091 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11096 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11098 dxdv(k+3,ind1+1)=dxoijk
11103 ! Derivatives in alpha and omega:
11106 ! dsci=dsc(itype(i,1))
11111 if(alphi.ne.alphi) alphi=100.0
11112 if(omegi.ne.omegi) omegi=-100.0
11117 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11118 cosalphi=dcos(alphi)
11119 sinalphi=dsin(alphi)
11120 cosomegi=dcos(omegi)
11121 sinomegi=dsin(omegi)
11122 temp(1,1)=-dsci*sinalphi
11123 temp(2,1)= dsci*cosalphi*cosomegi
11124 temp(3,1)=-dsci*cosalphi*sinomegi
11126 temp(2,2)=-dsci*sinalphi*sinomegi
11127 temp(3,2)=-dsci*sinalphi*cosomegi
11128 theta2=pi-0.5D0*theta(i+1)
11132 !d print *,((temp(l,k),l=1,3),k=1,2)
11136 xxp= xp*cost2+yp*sint2
11137 yyp=-xp*sint2+yp*cost2
11140 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11141 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11145 dj=dj+prod(k,l,i-1)*xx(l)
11153 end subroutine cartder
11154 !-----------------------------------------------------------------------------
11156 !-----------------------------------------------------------------------------
11157 subroutine check_cartgrad
11158 ! Check the gradient of Cartesian coordinates in internal coordinates.
11159 ! implicit real*8 (a-h,o-z)
11160 ! include 'DIMENSIONS'
11161 ! include 'COMMON.IOUNITS'
11162 ! include 'COMMON.VAR'
11163 ! include 'COMMON.CHAIN'
11164 ! include 'COMMON.GEO'
11165 ! include 'COMMON.LOCAL'
11166 ! include 'COMMON.DERIV'
11167 real(kind=8),dimension(6,nres) :: temp
11168 real(kind=8),dimension(3) :: xx,gg
11169 integer :: i,k,j,ii
11170 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11171 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11173 ! Check the gradient of the virtual-bond and SC vectors in the internal
11179 write (iout,'(a)') '**************** dx/dalpha'
11183 alph(i)=alph(i)+aincr
11185 temp(k,i)=dc(k,nres+i)
11189 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11190 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11192 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11193 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11199 write (iout,'(a)') '**************** dx/domega'
11203 omeg(i)=omeg(i)+aincr
11205 temp(k,i)=dc(k,nres+i)
11209 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11210 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11211 (aincr*dabs(dxds(k+3,i))+aincr))
11213 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11214 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11220 write (iout,'(a)') '**************** dx/dtheta'
11224 theta(i)=theta(i)+aincr
11227 temp(k,j)=dc(k,nres+j)
11233 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11235 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11236 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11237 (aincr*dabs(dxdv(k,ii))+aincr))
11239 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11240 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11247 write (iout,'(a)') '***************** dx/dphi'
11250 phi(i)=phi(i)+aincr
11253 temp(k,j)=dc(k,nres+j)
11261 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11262 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11263 (aincr*dabs(dxdv(k+3,ii))+aincr))
11265 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11266 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11269 phi(i)=phi(i)-aincr
11272 write (iout,'(a)') '****************** ddc/dtheta'
11275 theta(i+2)=thet+aincr
11286 gg(k)=(dc(k,j)-temp(k,j))/aincr
11287 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11288 (aincr*dabs(dcdv(k,ii))+aincr))
11290 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11291 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11301 write (iout,'(a)') '******************* ddc/dphi'
11304 phi(i+3)=phii+aincr
11315 gg(k)=(dc(k,j)-temp(k,j))/aincr
11316 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11317 (aincr*dabs(dcdv(k+3,ii))+aincr))
11319 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11320 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11331 end subroutine check_cartgrad
11332 !-----------------------------------------------------------------------------
11333 subroutine check_ecart
11334 ! Check the gradient of the energy in Cartesian coordinates.
11335 ! implicit real*8 (a-h,o-z)
11336 ! include 'DIMENSIONS'
11337 ! include 'COMMON.CHAIN'
11338 ! include 'COMMON.DERIV'
11339 ! include 'COMMON.IOUNITS'
11340 ! include 'COMMON.VAR'
11341 ! include 'COMMON.CONTACTS'
11343 !el integer :: icall
11344 !el common /srutu/ icall
11345 real(kind=8),dimension(6) :: ggg
11346 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11347 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11348 real(kind=8),dimension(6,nres) :: grad_s
11349 real(kind=8),dimension(0:n_ene) :: energia,energia1
11350 integer :: uiparm(1)
11351 real(kind=8) :: urparm(1)
11353 integer :: nf,i,j,k
11354 real(kind=8) :: aincr,etot,etot1
11360 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11363 call geom_to_var(nvar,x)
11364 call etotal(energia)
11366 !el call enerprint(energia)
11367 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11370 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11374 grad_s(j,i)=gradc(j,i,icg)
11375 grad_s(j+3,i)=gradx(j,i,icg)
11379 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11384 ddx(j)=dc(j,i+nres)
11387 dc(j,i)=dc(j,i)+aincr
11389 c(j,k)=c(j,k)+aincr
11390 c(j,k+nres)=c(j,k+nres)+aincr
11392 call etotal(energia1)
11394 ggg(j)=(etot1-etot)/aincr
11397 c(j,k)=c(j,k)-aincr
11398 c(j,k+nres)=c(j,k+nres)-aincr
11402 c(j,i+nres)=c(j,i+nres)+aincr
11403 dc(j,i+nres)=dc(j,i+nres)+aincr
11404 call etotal(energia1)
11406 ggg(j+3)=(etot1-etot)/aincr
11408 dc(j,i+nres)=ddx(j)
11410 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11411 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11414 end subroutine check_ecart
11416 !-----------------------------------------------------------------------------
11417 subroutine check_ecartint
11418 ! Check the gradient of the energy in Cartesian coordinates.
11419 use io_base, only: intout
11420 ! implicit real*8 (a-h,o-z)
11421 ! include 'DIMENSIONS'
11422 ! include 'COMMON.CONTROL'
11423 ! include 'COMMON.CHAIN'
11424 ! include 'COMMON.DERIV'
11425 ! include 'COMMON.IOUNITS'
11426 ! include 'COMMON.VAR'
11427 ! include 'COMMON.CONTACTS'
11428 ! include 'COMMON.MD'
11429 ! include 'COMMON.LOCAL'
11430 ! include 'COMMON.SPLITELE'
11432 !el integer :: icall
11433 !el common /srutu/ icall
11434 real(kind=8),dimension(6) :: ggg,ggg1
11435 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11436 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11437 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11438 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11439 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11440 real(kind=8),dimension(0:n_ene) :: energia,energia1
11441 integer :: uiparm(1)
11442 real(kind=8) :: urparm(1)
11444 integer :: i,j,k,nf
11445 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11453 ! call intcartderiv
11454 ! call checkintcartgrad
11457 write(iout,*) 'Calling CHECK_ECARTINT.'
11460 write (iout,*) "Before geom_to_var"
11461 call geom_to_var(nvar,x)
11462 write (iout,*) "after geom_to_var"
11463 write (iout,*) "split_ene ",split_ene
11465 if (.not.split_ene) then
11466 write(iout,*) 'Calling CHECK_ECARTINT if'
11467 call etotal(energia)
11468 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11470 write (iout,*) "etot",etot
11472 !el call enerprint(energia)
11473 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11475 write (iout,*) "enter cartgrad"
11478 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11479 write (iout,*) "exit cartgrad"
11483 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11486 grad_s(j,0)=gcart(j,0)
11488 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11491 grad_s(j,i)=gcart(j,i)
11492 grad_s(j+3,i)=gxcart(j,i)
11496 write(iout,*) 'Calling CHECK_ECARTIN else.'
11497 !- split gradient check
11499 call etotal_long(energia)
11500 !el call enerprint(energia)
11502 write (iout,*) "enter cartgrad"
11505 write (iout,*) "exit cartgrad"
11508 write (iout,*) "longrange grad"
11510 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11511 (gxcart(j,i),j=1,3)
11514 grad_s(j,0)=gcart(j,0)
11518 grad_s(j,i)=gcart(j,i)
11519 grad_s(j+3,i)=gxcart(j,i)
11523 call etotal_short(energia)
11524 !el call enerprint(energia)
11526 write (iout,*) "enter cartgrad"
11529 write (iout,*) "exit cartgrad"
11532 write (iout,*) "shortrange grad"
11534 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11535 (gxcart(j,i),j=1,3)
11538 grad_s1(j,0)=gcart(j,0)
11542 grad_s1(j,i)=gcart(j,i)
11543 grad_s1(j+3,i)=gxcart(j,i)
11547 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11551 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11552 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11555 dcnorm_safe1(j)=dc_norm(j,i-1)
11556 dcnorm_safe2(j)=dc_norm(j,i)
11557 dxnorm_safe(j)=dc_norm(j,i+nres)
11560 c(j,i)=ddc(j)+aincr
11561 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11562 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11563 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11564 dc(j,i)=c(j,i+1)-c(j,i)
11565 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11566 call int_from_cart1(.false.)
11567 if (.not.split_ene) then
11568 call etotal(energia1)
11570 write (iout,*) "ij",i,j," etot1",etot1
11573 call etotal_long(energia1)
11575 call etotal_short(energia1)
11578 !- end split gradient
11579 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11580 c(j,i)=ddc(j)-aincr
11581 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11582 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11583 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11584 dc(j,i)=c(j,i+1)-c(j,i)
11585 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11586 call int_from_cart1(.false.)
11587 if (.not.split_ene) then
11588 call etotal(energia1)
11590 write (iout,*) "ij",i,j," etot2",etot2
11591 ggg(j)=(etot1-etot2)/(2*aincr)
11594 call etotal_long(energia1)
11596 ggg(j)=(etot11-etot21)/(2*aincr)
11597 call etotal_short(energia1)
11599 ggg1(j)=(etot12-etot22)/(2*aincr)
11600 !- end split gradient
11601 ! write (iout,*) "etot21",etot21," etot22",etot22
11603 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11605 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11606 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11607 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11608 dc(j,i)=c(j,i+1)-c(j,i)
11609 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11610 dc_norm(j,i-1)=dcnorm_safe1(j)
11611 dc_norm(j,i)=dcnorm_safe2(j)
11612 dc_norm(j,i+nres)=dxnorm_safe(j)
11615 c(j,i+nres)=ddx(j)+aincr
11616 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11617 call int_from_cart1(.false.)
11618 if (.not.split_ene) then
11619 call etotal(energia1)
11623 call etotal_long(energia1)
11625 call etotal_short(energia1)
11628 !- end split gradient
11629 c(j,i+nres)=ddx(j)-aincr
11630 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11631 call int_from_cart1(.false.)
11632 if (.not.split_ene) then
11633 call etotal(energia1)
11635 ggg(j+3)=(etot1-etot2)/(2*aincr)
11638 call etotal_long(energia1)
11640 ggg(j+3)=(etot11-etot21)/(2*aincr)
11641 call etotal_short(energia1)
11643 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11644 !- end split gradient
11646 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11648 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11649 dc_norm(j,i+nres)=dxnorm_safe(j)
11650 call int_from_cart1(.false.)
11652 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11653 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11654 if (split_ene) then
11655 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11656 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11658 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11659 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11660 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11664 end subroutine check_ecartint
11666 !-----------------------------------------------------------------------------
11667 subroutine check_ecartint
11668 ! Check the gradient of the energy in Cartesian coordinates.
11669 use io_base, only: intout
11670 ! implicit real*8 (a-h,o-z)
11671 ! include 'DIMENSIONS'
11672 ! include 'COMMON.CONTROL'
11673 ! include 'COMMON.CHAIN'
11674 ! include 'COMMON.DERIV'
11675 ! include 'COMMON.IOUNITS'
11676 ! include 'COMMON.VAR'
11677 ! include 'COMMON.CONTACTS'
11678 ! include 'COMMON.MD'
11679 ! include 'COMMON.LOCAL'
11680 ! include 'COMMON.SPLITELE'
11682 !el integer :: icall
11683 !el common /srutu/ icall
11684 real(kind=8),dimension(6) :: ggg,ggg1
11685 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11686 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11687 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11688 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11689 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11690 real(kind=8),dimension(0:n_ene) :: energia,energia1
11691 integer :: uiparm(1)
11692 real(kind=8) :: urparm(1)
11694 integer :: i,j,k,nf
11695 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11703 ! call intcartderiv
11704 ! call checkintcartgrad
11707 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
11710 call geom_to_var(nvar,x)
11711 if (.not.split_ene) then
11712 call etotal(energia)
11714 !el call enerprint(energia)
11716 write (iout,*) "enter cartgrad"
11719 write (iout,*) "exit cartgrad"
11723 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11726 grad_s(j,0)=gcart(j,0)
11730 grad_s(j,i)=gcart(j,i)
11731 grad_s(j+3,i)=gxcart(j,i)
11735 !- split gradient check
11737 call etotal_long(energia)
11738 !el call enerprint(energia)
11740 write (iout,*) "enter cartgrad"
11743 write (iout,*) "exit cartgrad"
11746 write (iout,*) "longrange grad"
11748 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11749 (gxcart(j,i),j=1,3)
11752 grad_s(j,0)=gcart(j,0)
11756 grad_s(j,i)=gcart(j,i)
11757 grad_s(j+3,i)=gxcart(j,i)
11761 call etotal_short(energia)
11762 !el call enerprint(energia)
11764 write (iout,*) "enter cartgrad"
11767 write (iout,*) "exit cartgrad"
11770 write (iout,*) "shortrange grad"
11772 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11773 (gxcart(j,i),j=1,3)
11776 grad_s1(j,0)=gcart(j,0)
11780 grad_s1(j,i)=gcart(j,i)
11781 grad_s1(j+3,i)=gxcart(j,i)
11785 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11790 ddx(j)=dc(j,i+nres)
11792 dcnorm_safe(k)=dc_norm(k,i)
11793 dxnorm_safe(k)=dc_norm(k,i+nres)
11797 dc(j,i)=ddc(j)+aincr
11798 call chainbuild_cart
11800 ! Broadcast the order to compute internal coordinates to the slaves.
11801 ! if (nfgtasks.gt.1)
11802 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
11804 ! call int_from_cart1(.false.)
11805 if (.not.split_ene) then
11806 call etotal(energia1)
11810 call etotal_long(energia1)
11812 call etotal_short(energia1)
11814 ! write (iout,*) "etot11",etot11," etot12",etot12
11816 !- end split gradient
11817 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11818 dc(j,i)=ddc(j)-aincr
11819 call chainbuild_cart
11820 ! call int_from_cart1(.false.)
11821 if (.not.split_ene) then
11822 call etotal(energia1)
11824 ggg(j)=(etot1-etot2)/(2*aincr)
11827 call etotal_long(energia1)
11829 ggg(j)=(etot11-etot21)/(2*aincr)
11830 call etotal_short(energia1)
11832 ggg1(j)=(etot12-etot22)/(2*aincr)
11833 !- end split gradient
11834 ! write (iout,*) "etot21",etot21," etot22",etot22
11836 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11838 call chainbuild_cart
11841 dc(j,i+nres)=ddx(j)+aincr
11842 call chainbuild_cart
11843 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
11844 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11845 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11846 ! write (iout,*) "dxnormnorm",dsqrt(
11847 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11848 ! write (iout,*) "dxnormnormsafe",dsqrt(
11849 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11851 if (.not.split_ene) then
11852 call etotal(energia1)
11856 call etotal_long(energia1)
11858 call etotal_short(energia1)
11861 !- end split gradient
11862 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11863 dc(j,i+nres)=ddx(j)-aincr
11864 call chainbuild_cart
11865 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
11866 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11867 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11869 ! write (iout,*) "dxnormnorm",dsqrt(
11870 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11871 ! write (iout,*) "dxnormnormsafe",dsqrt(
11872 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11873 if (.not.split_ene) then
11874 call etotal(energia1)
11876 ggg(j+3)=(etot1-etot2)/(2*aincr)
11879 call etotal_long(energia1)
11881 ggg(j+3)=(etot11-etot21)/(2*aincr)
11882 call etotal_short(energia1)
11884 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11885 !- end split gradient
11887 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11888 dc(j,i+nres)=ddx(j)
11889 call chainbuild_cart
11891 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11892 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11893 if (split_ene) then
11894 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11895 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11897 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11898 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11899 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11903 end subroutine check_ecartint
11905 !-----------------------------------------------------------------------------
11906 subroutine check_eint
11907 ! Check the gradient of energy in internal coordinates.
11908 ! implicit real*8 (a-h,o-z)
11909 ! include 'DIMENSIONS'
11910 ! include 'COMMON.CHAIN'
11911 ! include 'COMMON.DERIV'
11912 ! include 'COMMON.IOUNITS'
11913 ! include 'COMMON.VAR'
11914 ! include 'COMMON.GEO'
11916 !el integer :: icall
11917 !el common /srutu/ icall
11918 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
11919 integer :: uiparm(1)
11920 real(kind=8) :: urparm(1)
11921 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
11922 character(len=6) :: key
11925 real(kind=8) :: xi,aincr,etot,etot1,etot2
11928 print '(a)','Calling CHECK_INT.'
11932 call geom_to_var(nvar,x)
11933 call var_to_geom(nvar,x)
11937 call etotal(energia)
11939 !el call enerprint(energia)
11942 if (MyID.ne.BossID) then
11943 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
11951 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
11952 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
11953 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
11957 x(i)=xi-0.5D0*aincr
11958 call var_to_geom(nvar,x)
11960 call etotal(energia1)
11962 x(i)=xi+0.5D0*aincr
11963 call var_to_geom(nvar,x)
11965 call etotal(energia2)
11967 gg(i)=(etot2-etot1)/aincr
11968 write (iout,*) i,etot1,etot2
11971 write (iout,'(/2a)')' Variable Numerical Analytical',&
11974 if (i.le.nphi) then
11977 else if (i.le.nphi+ntheta) then
11980 else if (i.le.nphi+ntheta+nside) then
11984 ii=i-(nphi+ntheta+nside)
11987 write (iout,'(i3,a,i3,3(1pd16.6))') &
11988 i,key,ii,gg(i),gana(i),&
11989 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
11992 end subroutine check_eint
11993 !-----------------------------------------------------------------------------
11995 !-----------------------------------------------------------------------------
11996 subroutine Econstr_back
11997 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
11998 ! implicit real*8 (a-h,o-z)
11999 ! include 'DIMENSIONS'
12000 ! include 'COMMON.CONTROL'
12001 ! include 'COMMON.VAR'
12002 ! include 'COMMON.MD'
12005 ! include 'COMMON.LANGEVIN'
12007 ! include 'COMMON.LANGEVIN.lang0'
12009 ! include 'COMMON.CHAIN'
12010 ! include 'COMMON.DERIV'
12011 ! include 'COMMON.GEO'
12012 ! include 'COMMON.LOCAL'
12013 ! include 'COMMON.INTERACT'
12014 ! include 'COMMON.IOUNITS'
12015 ! include 'COMMON.NAMES'
12016 ! include 'COMMON.TIME1'
12017 integer :: i,j,ii,k
12018 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12020 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12021 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12022 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12029 duscdiff(j,i)=0.0d0
12030 duscdiffx(j,i)=0.0d0
12034 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12036 ! Deviations from theta angles
12039 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12040 dtheta_i=theta(j)-thetaref(j)
12041 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12042 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12044 utheta(i)=utheta_i/(ii-1)
12046 ! Deviations from gamma angles
12049 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12050 dgamma_i=pinorm(phi(j)-phiref(j))
12051 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12052 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12053 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12054 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12056 ugamma(i)=ugamma_i/(ii-2)
12058 ! Deviations from local SC geometry
12061 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12062 dxx=xxtab(j)-xxref(j)
12063 dyy=yytab(j)-yyref(j)
12064 dzz=zztab(j)-zzref(j)
12065 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12067 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12068 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12070 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12071 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12073 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12074 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12077 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12078 ! & xxref(j),yyref(j),zzref(j)
12080 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12081 ! write (iout,*) i," uscdiff",uscdiff(i)
12083 ! Put together deviations from local geometry
12085 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12086 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12087 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12088 ! & " uconst_back",uconst_back
12089 utheta(i)=dsqrt(utheta(i))
12090 ugamma(i)=dsqrt(ugamma(i))
12091 uscdiff(i)=dsqrt(uscdiff(i))
12094 end subroutine Econstr_back
12095 !-----------------------------------------------------------------------------
12096 ! energy_p_new-sep_barrier.F
12097 !-----------------------------------------------------------------------------
12098 real(kind=8) function sscale(r)
12099 ! include "COMMON.SPLITELE"
12100 real(kind=8) :: r,gamm
12101 if(r.lt.r_cut-rlamb) then
12103 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12104 gamm=(r-(r_cut-rlamb))/rlamb
12105 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12110 end function sscale
12111 real(kind=8) function sscale_grad(r)
12112 ! include "COMMON.SPLITELE"
12113 real(kind=8) :: r,gamm
12114 if(r.lt.r_cut-rlamb) then
12116 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12117 gamm=(r-(r_cut-rlamb))/rlamb
12118 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12123 end function sscale_grad
12125 !!!!!!!!!! PBCSCALE
12126 real(kind=8) function sscale_ele(r)
12127 ! include "COMMON.SPLITELE"
12128 real(kind=8) :: r,gamm
12129 if(r.lt.r_cut_ele-rlamb_ele) then
12131 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12132 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12133 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12138 end function sscale_ele
12140 real(kind=8) function sscagrad_ele(r)
12141 real(kind=8) :: r,gamm
12142 ! include "COMMON.SPLITELE"
12143 if(r.lt.r_cut_ele-rlamb_ele) then
12145 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12146 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12147 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12152 end function sscagrad_ele
12153 real(kind=8) function sscalelip(r)
12154 real(kind=8) r,gamm
12155 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12157 end function sscalelip
12158 !C-----------------------------------------------------------------------
12159 real(kind=8) function sscagradlip(r)
12160 real(kind=8) r,gamm
12161 sscagradlip=r*(6.0d0*r-6.0d0)
12163 end function sscagradlip
12166 !-----------------------------------------------------------------------------
12167 subroutine elj_long(evdw)
12169 ! This subroutine calculates the interaction energy of nonbonded side chains
12170 ! assuming the LJ potential of interaction.
12172 ! implicit real*8 (a-h,o-z)
12173 ! include 'DIMENSIONS'
12174 ! include 'COMMON.GEO'
12175 ! include 'COMMON.VAR'
12176 ! include 'COMMON.LOCAL'
12177 ! include 'COMMON.CHAIN'
12178 ! include 'COMMON.DERIV'
12179 ! include 'COMMON.INTERACT'
12180 ! include 'COMMON.TORSION'
12181 ! include 'COMMON.SBRIDGE'
12182 ! include 'COMMON.NAMES'
12183 ! include 'COMMON.IOUNITS'
12184 ! include 'COMMON.CONTACTS'
12185 real(kind=8),parameter :: accur=1.0d-10
12186 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12187 !el local variables
12188 integer :: i,iint,j,k,itypi,itypi1,itypj
12189 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12190 real(kind=8) :: e1,e2,evdwij,evdw
12191 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12193 do i=iatsc_s,iatsc_e
12195 if (itypi.eq.ntyp1) cycle
12196 itypi1=itype(i+1,1)
12201 ! Calculate SC interaction energy.
12203 do iint=1,nint_gr(i)
12204 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12205 !d & 'iend=',iend(i,iint)
12206 do j=istart(i,iint),iend(i,iint)
12208 if (itypj.eq.ntyp1) cycle
12212 rij=xj*xj+yj*yj+zj*zj
12213 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12214 if (sss.lt.1.0d0) then
12216 eps0ij=eps(itypi,itypj)
12218 e1=fac*fac*aa_aq(itypi,itypj)
12219 e2=fac*bb_aq(itypi,itypj)
12221 evdw=evdw+(1.0d0-sss)*evdwij
12223 ! Calculate the components of the gradient in DC and X
12225 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12230 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12231 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12232 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12233 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12241 gvdwc(j,i)=expon*gvdwc(j,i)
12242 gvdwx(j,i)=expon*gvdwx(j,i)
12245 !******************************************************************************
12249 ! To save time, the factor of EXPON has been extracted from ALL components
12250 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12253 !******************************************************************************
12255 end subroutine elj_long
12256 !-----------------------------------------------------------------------------
12257 subroutine elj_short(evdw)
12259 ! This subroutine calculates the interaction energy of nonbonded side chains
12260 ! assuming the LJ potential of interaction.
12262 ! implicit real*8 (a-h,o-z)
12263 ! include 'DIMENSIONS'
12264 ! include 'COMMON.GEO'
12265 ! include 'COMMON.VAR'
12266 ! include 'COMMON.LOCAL'
12267 ! include 'COMMON.CHAIN'
12268 ! include 'COMMON.DERIV'
12269 ! include 'COMMON.INTERACT'
12270 ! include 'COMMON.TORSION'
12271 ! include 'COMMON.SBRIDGE'
12272 ! include 'COMMON.NAMES'
12273 ! include 'COMMON.IOUNITS'
12274 ! include 'COMMON.CONTACTS'
12275 real(kind=8),parameter :: accur=1.0d-10
12276 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12277 !el local variables
12278 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12279 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12280 real(kind=8) :: e1,e2,evdwij,evdw
12281 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12283 do i=iatsc_s,iatsc_e
12285 if (itypi.eq.ntyp1) cycle
12286 itypi1=itype(i+1,1)
12293 ! Calculate SC interaction energy.
12295 do iint=1,nint_gr(i)
12296 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12297 !d & 'iend=',iend(i,iint)
12298 do j=istart(i,iint),iend(i,iint)
12300 if (itypj.eq.ntyp1) cycle
12304 ! Change 12/1/95 to calculate four-body interactions
12305 rij=xj*xj+yj*yj+zj*zj
12306 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12307 if (sss.gt.0.0d0) then
12309 eps0ij=eps(itypi,itypj)
12311 e1=fac*fac*aa_aq(itypi,itypj)
12312 e2=fac*bb_aq(itypi,itypj)
12314 evdw=evdw+sss*evdwij
12316 ! Calculate the components of the gradient in DC and X
12318 fac=-rrij*(e1+evdwij)*sss
12323 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12324 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12325 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12326 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12334 gvdwc(j,i)=expon*gvdwc(j,i)
12335 gvdwx(j,i)=expon*gvdwx(j,i)
12338 !******************************************************************************
12342 ! To save time, the factor of EXPON has been extracted from ALL components
12343 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12346 !******************************************************************************
12348 end subroutine elj_short
12349 !-----------------------------------------------------------------------------
12350 subroutine eljk_long(evdw)
12352 ! This subroutine calculates the interaction energy of nonbonded side chains
12353 ! assuming the LJK potential of interaction.
12355 ! implicit real*8 (a-h,o-z)
12356 ! include 'DIMENSIONS'
12357 ! include 'COMMON.GEO'
12358 ! include 'COMMON.VAR'
12359 ! include 'COMMON.LOCAL'
12360 ! include 'COMMON.CHAIN'
12361 ! include 'COMMON.DERIV'
12362 ! include 'COMMON.INTERACT'
12363 ! include 'COMMON.IOUNITS'
12364 ! include 'COMMON.NAMES'
12365 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12367 !el local variables
12368 integer :: i,iint,j,k,itypi,itypi1,itypj
12369 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12370 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12371 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12373 do i=iatsc_s,iatsc_e
12375 if (itypi.eq.ntyp1) cycle
12376 itypi1=itype(i+1,1)
12381 ! Calculate SC interaction energy.
12383 do iint=1,nint_gr(i)
12384 do j=istart(i,iint),iend(i,iint)
12386 if (itypj.eq.ntyp1) cycle
12390 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12391 fac_augm=rrij**expon
12392 e_augm=augm(itypi,itypj)*fac_augm
12393 r_inv_ij=dsqrt(rrij)
12395 sss=sscale(rij/sigma(itypi,itypj))
12396 if (sss.lt.1.0d0) then
12397 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12398 fac=r_shift_inv**expon
12399 e1=fac*fac*aa_aq(itypi,itypj)
12400 e2=fac*bb_aq(itypi,itypj)
12401 evdwij=e_augm+e1+e2
12402 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12403 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12404 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12405 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12406 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12407 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12408 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12409 evdw=evdw+(1.0d0-sss)*evdwij
12411 ! Calculate the components of the gradient in DC and X
12413 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12414 fac=fac*(1.0d0-sss)
12419 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12420 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12421 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12422 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12430 gvdwc(j,i)=expon*gvdwc(j,i)
12431 gvdwx(j,i)=expon*gvdwx(j,i)
12435 end subroutine eljk_long
12436 !-----------------------------------------------------------------------------
12437 subroutine eljk_short(evdw)
12439 ! This subroutine calculates the interaction energy of nonbonded side chains
12440 ! assuming the LJK potential of interaction.
12442 ! implicit real*8 (a-h,o-z)
12443 ! include 'DIMENSIONS'
12444 ! include 'COMMON.GEO'
12445 ! include 'COMMON.VAR'
12446 ! include 'COMMON.LOCAL'
12447 ! include 'COMMON.CHAIN'
12448 ! include 'COMMON.DERIV'
12449 ! include 'COMMON.INTERACT'
12450 ! include 'COMMON.IOUNITS'
12451 ! include 'COMMON.NAMES'
12452 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12454 !el local variables
12455 integer :: i,iint,j,k,itypi,itypi1,itypj
12456 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12457 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12458 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12460 do i=iatsc_s,iatsc_e
12462 if (itypi.eq.ntyp1) cycle
12463 itypi1=itype(i+1,1)
12468 ! Calculate SC interaction energy.
12470 do iint=1,nint_gr(i)
12471 do j=istart(i,iint),iend(i,iint)
12473 if (itypj.eq.ntyp1) cycle
12477 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12478 fac_augm=rrij**expon
12479 e_augm=augm(itypi,itypj)*fac_augm
12480 r_inv_ij=dsqrt(rrij)
12482 sss=sscale(rij/sigma(itypi,itypj))
12483 if (sss.gt.0.0d0) then
12484 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12485 fac=r_shift_inv**expon
12486 e1=fac*fac*aa_aq(itypi,itypj)
12487 e2=fac*bb_aq(itypi,itypj)
12488 evdwij=e_augm+e1+e2
12489 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12490 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12491 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12492 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12493 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12494 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12495 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12496 evdw=evdw+sss*evdwij
12498 ! Calculate the components of the gradient in DC and X
12500 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12506 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12507 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12508 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12509 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12517 gvdwc(j,i)=expon*gvdwc(j,i)
12518 gvdwx(j,i)=expon*gvdwx(j,i)
12522 end subroutine eljk_short
12523 !-----------------------------------------------------------------------------
12524 subroutine ebp_long(evdw)
12526 ! This subroutine calculates the interaction energy of nonbonded side chains
12527 ! assuming the Berne-Pechukas potential of interaction.
12530 ! implicit real*8 (a-h,o-z)
12531 ! include 'DIMENSIONS'
12532 ! include 'COMMON.GEO'
12533 ! include 'COMMON.VAR'
12534 ! include 'COMMON.LOCAL'
12535 ! include 'COMMON.CHAIN'
12536 ! include 'COMMON.DERIV'
12537 ! include 'COMMON.NAMES'
12538 ! include 'COMMON.INTERACT'
12539 ! include 'COMMON.IOUNITS'
12540 ! include 'COMMON.CALC'
12542 !el integer :: icall
12543 !el common /srutu/ icall
12544 ! double precision rrsave(maxdim)
12546 !el local variables
12547 integer :: iint,itypi,itypi1,itypj
12548 real(kind=8) :: rrij,xi,yi,zi,fac
12549 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12551 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12553 ! if (icall.eq.0) then
12559 do i=iatsc_s,iatsc_e
12561 if (itypi.eq.ntyp1) cycle
12562 itypi1=itype(i+1,1)
12566 dxi=dc_norm(1,nres+i)
12567 dyi=dc_norm(2,nres+i)
12568 dzi=dc_norm(3,nres+i)
12569 ! dsci_inv=dsc_inv(itypi)
12570 dsci_inv=vbld_inv(i+nres)
12572 ! Calculate SC interaction energy.
12574 do iint=1,nint_gr(i)
12575 do j=istart(i,iint),iend(i,iint)
12578 if (itypj.eq.ntyp1) cycle
12579 ! dscj_inv=dsc_inv(itypj)
12580 dscj_inv=vbld_inv(j+nres)
12581 chi1=chi(itypi,itypj)
12582 chi2=chi(itypj,itypi)
12589 alf12=0.5D0*(alf1+alf2)
12593 dxj=dc_norm(1,nres+j)
12594 dyj=dc_norm(2,nres+j)
12595 dzj=dc_norm(3,nres+j)
12596 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12598 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12600 if (sss.lt.1.0d0) then
12602 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12604 ! Calculate whole angle-dependent part of epsilon and contributions
12605 ! to its derivatives
12606 fac=(rrij*sigsq)**expon2
12607 e1=fac*fac*aa_aq(itypi,itypj)
12608 e2=fac*bb_aq(itypi,itypj)
12609 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12610 eps2der=evdwij*eps3rt
12611 eps3der=evdwij*eps2rt
12612 evdwij=evdwij*eps2rt*eps3rt
12613 evdw=evdw+evdwij*(1.0d0-sss)
12615 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12616 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12617 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12618 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12619 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12620 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12621 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12624 ! Calculate gradient components.
12625 e1=e1*eps1*eps2rt**2*eps3rt**2
12626 fac=-expon*(e1+evdwij)
12629 ! Calculate radial part of the gradient
12633 ! Calculate the angular part of the gradient and sum add the contributions
12634 ! to the appropriate components of the Cartesian gradient.
12635 call sc_grad_scale(1.0d0-sss)
12642 end subroutine ebp_long
12643 !-----------------------------------------------------------------------------
12644 subroutine ebp_short(evdw)
12646 ! This subroutine calculates the interaction energy of nonbonded side chains
12647 ! assuming the Berne-Pechukas potential of interaction.
12650 ! implicit real*8 (a-h,o-z)
12651 ! include 'DIMENSIONS'
12652 ! include 'COMMON.GEO'
12653 ! include 'COMMON.VAR'
12654 ! include 'COMMON.LOCAL'
12655 ! include 'COMMON.CHAIN'
12656 ! include 'COMMON.DERIV'
12657 ! include 'COMMON.NAMES'
12658 ! include 'COMMON.INTERACT'
12659 ! include 'COMMON.IOUNITS'
12660 ! include 'COMMON.CALC'
12662 !el integer :: icall
12663 !el common /srutu/ icall
12664 ! double precision rrsave(maxdim)
12666 !el local variables
12667 integer :: iint,itypi,itypi1,itypj
12668 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12669 real(kind=8) :: sss,e1,e2,evdw
12671 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12673 ! if (icall.eq.0) then
12679 do i=iatsc_s,iatsc_e
12681 if (itypi.eq.ntyp1) cycle
12682 itypi1=itype(i+1,1)
12686 dxi=dc_norm(1,nres+i)
12687 dyi=dc_norm(2,nres+i)
12688 dzi=dc_norm(3,nres+i)
12689 ! dsci_inv=dsc_inv(itypi)
12690 dsci_inv=vbld_inv(i+nres)
12692 ! Calculate SC interaction energy.
12694 do iint=1,nint_gr(i)
12695 do j=istart(i,iint),iend(i,iint)
12698 if (itypj.eq.ntyp1) cycle
12699 ! dscj_inv=dsc_inv(itypj)
12700 dscj_inv=vbld_inv(j+nres)
12701 chi1=chi(itypi,itypj)
12702 chi2=chi(itypj,itypi)
12709 alf12=0.5D0*(alf1+alf2)
12713 dxj=dc_norm(1,nres+j)
12714 dyj=dc_norm(2,nres+j)
12715 dzj=dc_norm(3,nres+j)
12716 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12718 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12720 if (sss.gt.0.0d0) then
12722 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12724 ! Calculate whole angle-dependent part of epsilon and contributions
12725 ! to its derivatives
12726 fac=(rrij*sigsq)**expon2
12727 e1=fac*fac*aa_aq(itypi,itypj)
12728 e2=fac*bb_aq(itypi,itypj)
12729 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12730 eps2der=evdwij*eps3rt
12731 eps3der=evdwij*eps2rt
12732 evdwij=evdwij*eps2rt*eps3rt
12733 evdw=evdw+evdwij*sss
12735 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12736 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12737 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12738 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12739 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12740 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12741 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12744 ! Calculate gradient components.
12745 e1=e1*eps1*eps2rt**2*eps3rt**2
12746 fac=-expon*(e1+evdwij)
12749 ! Calculate radial part of the gradient
12753 ! Calculate the angular part of the gradient and sum add the contributions
12754 ! to the appropriate components of the Cartesian gradient.
12755 call sc_grad_scale(sss)
12762 end subroutine ebp_short
12763 !-----------------------------------------------------------------------------
12764 subroutine egb_long(evdw)
12766 ! This subroutine calculates the interaction energy of nonbonded side chains
12767 ! assuming the Gay-Berne potential of interaction.
12770 ! implicit real*8 (a-h,o-z)
12771 ! include 'DIMENSIONS'
12772 ! include 'COMMON.GEO'
12773 ! include 'COMMON.VAR'
12774 ! include 'COMMON.LOCAL'
12775 ! include 'COMMON.CHAIN'
12776 ! include 'COMMON.DERIV'
12777 ! include 'COMMON.NAMES'
12778 ! include 'COMMON.INTERACT'
12779 ! include 'COMMON.IOUNITS'
12780 ! include 'COMMON.CALC'
12781 ! include 'COMMON.CONTROL'
12783 !el local variables
12784 integer :: iint,itypi,itypi1,itypj,subchap
12785 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
12786 real(kind=8) :: sss,e1,e2,evdw,sss_grad
12787 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12788 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12789 ssgradlipi,ssgradlipj
12793 !cccc energy_dec=.false.
12794 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12797 ! if (icall.eq.0) lprn=.false.
12799 do i=iatsc_s,iatsc_e
12801 if (itypi.eq.ntyp1) cycle
12802 itypi1=itype(i+1,1)
12806 xi=mod(xi,boxxsize)
12807 if (xi.lt.0) xi=xi+boxxsize
12808 yi=mod(yi,boxysize)
12809 if (yi.lt.0) yi=yi+boxysize
12810 zi=mod(zi,boxzsize)
12811 if (zi.lt.0) zi=zi+boxzsize
12812 if ((zi.gt.bordlipbot) &
12813 .and.(zi.lt.bordliptop)) then
12814 !C the energy transfer exist
12815 if (zi.lt.buflipbot) then
12816 !C what fraction I am in
12818 ((zi-bordlipbot)/lipbufthick)
12819 !C lipbufthick is thickenes of lipid buffore
12820 sslipi=sscalelip(fracinbuf)
12821 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12822 elseif (zi.gt.bufliptop) then
12823 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12824 sslipi=sscalelip(fracinbuf)
12825 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12835 dxi=dc_norm(1,nres+i)
12836 dyi=dc_norm(2,nres+i)
12837 dzi=dc_norm(3,nres+i)
12838 ! dsci_inv=dsc_inv(itypi)
12839 dsci_inv=vbld_inv(i+nres)
12840 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12841 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12843 ! Calculate SC interaction energy.
12845 do iint=1,nint_gr(i)
12846 do j=istart(i,iint),iend(i,iint)
12847 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12848 ! call dyn_ssbond_ene(i,j,evdwij)
12850 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12851 ! 'evdw',i,j,evdwij,' ss'
12852 ! if (energy_dec) write (iout,*) &
12853 ! 'evdw',i,j,evdwij,' ss'
12854 ! do k=j+1,iend(i,iint)
12855 !C search over all next residues
12856 ! if (dyn_ss_mask(k)) then
12857 !C check if they are cysteins
12858 !C write(iout,*) 'k=',k
12860 !c write(iout,*) "PRZED TRI", evdwij
12861 ! evdwij_przed_tri=evdwij
12862 ! call triple_ssbond_ene(i,j,k,evdwij)
12863 !c if(evdwij_przed_tri.ne.evdwij) then
12864 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
12867 !c write(iout,*) "PO TRI", evdwij
12868 !C call the energy function that removes the artifical triple disulfide
12869 !C bond the soubroutine is located in ssMD.F
12871 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12872 'evdw',i,j,evdwij,'tss'
12873 ! endif!dyn_ss_mask(k)
12879 if (itypj.eq.ntyp1) cycle
12880 ! dscj_inv=dsc_inv(itypj)
12881 dscj_inv=vbld_inv(j+nres)
12882 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12883 ! & 1.0d0/vbld(j+nres)
12884 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
12885 sig0ij=sigma(itypi,itypj)
12886 chi1=chi(itypi,itypj)
12887 chi2=chi(itypj,itypi)
12894 alf12=0.5D0*(alf1+alf2)
12898 ! Searching for nearest neighbour
12899 xj=mod(xj,boxxsize)
12900 if (xj.lt.0) xj=xj+boxxsize
12901 yj=mod(yj,boxysize)
12902 if (yj.lt.0) yj=yj+boxysize
12903 zj=mod(zj,boxzsize)
12904 if (zj.lt.0) zj=zj+boxzsize
12905 if ((zj.gt.bordlipbot) &
12906 .and.(zj.lt.bordliptop)) then
12907 !C the energy transfer exist
12908 if (zj.lt.buflipbot) then
12909 !C what fraction I am in
12911 ((zj-bordlipbot)/lipbufthick)
12912 !C lipbufthick is thickenes of lipid buffore
12913 sslipj=sscalelip(fracinbuf)
12914 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
12915 elseif (zj.gt.bufliptop) then
12916 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
12917 sslipj=sscalelip(fracinbuf)
12918 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
12927 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12928 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12929 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12930 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12932 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12940 xj=xj_safe+xshift*boxxsize
12941 yj=yj_safe+yshift*boxysize
12942 zj=zj_safe+zshift*boxzsize
12943 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12944 if(dist_temp.lt.dist_init) then
12945 dist_init=dist_temp
12954 if (subchap.eq.1) then
12964 dxj=dc_norm(1,nres+j)
12965 dyj=dc_norm(2,nres+j)
12966 dzj=dc_norm(3,nres+j)
12967 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12969 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12970 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
12971 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
12972 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
12973 if (sss_ele_cut.le.0.0) cycle
12974 if (sss.lt.1.0d0) then
12976 ! Calculate angle-dependent terms of energy and contributions to their
12980 sig=sig0ij*dsqrt(sigsq)
12981 rij_shift=1.0D0/rij-sig+sig0ij
12982 ! for diagnostics; uncomment
12983 ! rij_shift=1.2*sig0ij
12984 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12985 if (rij_shift.le.0.0D0) then
12987 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
12988 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12989 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
12993 !---------------------------------------------------------------
12994 rij_shift=1.0D0/rij_shift
12995 fac=rij_shift**expon
12998 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12999 eps2der=evdwij*eps3rt
13000 eps3der=evdwij*eps2rt
13001 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13002 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13003 evdwij=evdwij*eps2rt*eps3rt
13004 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13006 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13007 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13008 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13009 restyp(itypi,1),i,restyp(itypj,1),j,&
13010 epsi,sigm,chi1,chi2,chip1,chip2,&
13011 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13012 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13016 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13018 ! if (energy_dec) write (iout,*) &
13019 ! 'evdw',i,j,evdwij,"egb_long"
13021 ! Calculate gradient components.
13022 e1=e1*eps1*eps2rt**2*eps3rt**2
13023 fac=-expon*(e1+evdwij)*rij_shift
13026 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13027 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13028 /sigmaii(itypi,itypj))
13030 ! Calculate the radial part of the gradient
13034 ! Calculate angular part of the gradient.
13035 call sc_grad_scale(1.0d0-sss)
13041 ! write (iout,*) "Number of loop steps in EGB:",ind
13042 !ccc energy_dec=.false.
13044 end subroutine egb_long
13045 !-----------------------------------------------------------------------------
13046 subroutine egb_short(evdw)
13048 ! This subroutine calculates the interaction energy of nonbonded side chains
13049 ! assuming the Gay-Berne potential of interaction.
13052 ! implicit real*8 (a-h,o-z)
13053 ! include 'DIMENSIONS'
13054 ! include 'COMMON.GEO'
13055 ! include 'COMMON.VAR'
13056 ! include 'COMMON.LOCAL'
13057 ! include 'COMMON.CHAIN'
13058 ! include 'COMMON.DERIV'
13059 ! include 'COMMON.NAMES'
13060 ! include 'COMMON.INTERACT'
13061 ! include 'COMMON.IOUNITS'
13062 ! include 'COMMON.CALC'
13063 ! include 'COMMON.CONTROL'
13065 !el local variables
13066 integer :: iint,itypi,itypi1,itypj,subchap
13067 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13068 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13069 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13070 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13071 ssgradlipi,ssgradlipj
13073 !cccc energy_dec=.false.
13074 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13077 ! if (icall.eq.0) lprn=.false.
13079 do i=iatsc_s,iatsc_e
13081 if (itypi.eq.ntyp1) cycle
13082 itypi1=itype(i+1,1)
13086 xi=mod(xi,boxxsize)
13087 if (xi.lt.0) xi=xi+boxxsize
13088 yi=mod(yi,boxysize)
13089 if (yi.lt.0) yi=yi+boxysize
13090 zi=mod(zi,boxzsize)
13091 if (zi.lt.0) zi=zi+boxzsize
13092 if ((zi.gt.bordlipbot) &
13093 .and.(zi.lt.bordliptop)) then
13094 !C the energy transfer exist
13095 if (zi.lt.buflipbot) then
13096 !C what fraction I am in
13098 ((zi-bordlipbot)/lipbufthick)
13099 !C lipbufthick is thickenes of lipid buffore
13100 sslipi=sscalelip(fracinbuf)
13101 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13102 elseif (zi.gt.bufliptop) then
13103 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13104 sslipi=sscalelip(fracinbuf)
13105 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13115 dxi=dc_norm(1,nres+i)
13116 dyi=dc_norm(2,nres+i)
13117 dzi=dc_norm(3,nres+i)
13118 ! dsci_inv=dsc_inv(itypi)
13119 dsci_inv=vbld_inv(i+nres)
13121 dxi=dc_norm(1,nres+i)
13122 dyi=dc_norm(2,nres+i)
13123 dzi=dc_norm(3,nres+i)
13124 ! dsci_inv=dsc_inv(itypi)
13125 dsci_inv=vbld_inv(i+nres)
13126 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13127 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13129 ! Calculate SC interaction energy.
13131 do iint=1,nint_gr(i)
13132 do j=istart(i,iint),iend(i,iint)
13133 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13134 call dyn_ssbond_ene(i,j,evdwij)
13136 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13137 'evdw',i,j,evdwij,' ss'
13138 do k=j+1,iend(i,iint)
13139 !C search over all next residues
13140 if (dyn_ss_mask(k)) then
13141 !C check if they are cysteins
13142 !C write(iout,*) 'k=',k
13144 !c write(iout,*) "PRZED TRI", evdwij
13145 ! evdwij_przed_tri=evdwij
13146 call triple_ssbond_ene(i,j,k,evdwij)
13147 !c if(evdwij_przed_tri.ne.evdwij) then
13148 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13151 !c write(iout,*) "PO TRI", evdwij
13152 !C call the energy function that removes the artifical triple disulfide
13153 !C bond the soubroutine is located in ssMD.F
13155 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13156 'evdw',i,j,evdwij,'tss'
13157 endif!dyn_ss_mask(k)
13160 ! if (energy_dec) write (iout,*) &
13161 ! 'evdw',i,j,evdwij,' ss'
13165 if (itypj.eq.ntyp1) cycle
13166 ! dscj_inv=dsc_inv(itypj)
13167 dscj_inv=vbld_inv(j+nres)
13168 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13169 ! & 1.0d0/vbld(j+nres)
13170 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13171 sig0ij=sigma(itypi,itypj)
13172 chi1=chi(itypi,itypj)
13173 chi2=chi(itypj,itypi)
13180 alf12=0.5D0*(alf1+alf2)
13181 ! xj=c(1,nres+j)-xi
13182 ! yj=c(2,nres+j)-yi
13183 ! zj=c(3,nres+j)-zi
13187 ! Searching for nearest neighbour
13188 xj=mod(xj,boxxsize)
13189 if (xj.lt.0) xj=xj+boxxsize
13190 yj=mod(yj,boxysize)
13191 if (yj.lt.0) yj=yj+boxysize
13192 zj=mod(zj,boxzsize)
13193 if (zj.lt.0) zj=zj+boxzsize
13194 if ((zj.gt.bordlipbot) &
13195 .and.(zj.lt.bordliptop)) then
13196 !C the energy transfer exist
13197 if (zj.lt.buflipbot) then
13198 !C what fraction I am in
13200 ((zj-bordlipbot)/lipbufthick)
13201 !C lipbufthick is thickenes of lipid buffore
13202 sslipj=sscalelip(fracinbuf)
13203 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13204 elseif (zj.gt.bufliptop) then
13205 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13206 sslipj=sscalelip(fracinbuf)
13207 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13216 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13217 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13218 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13219 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13221 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13230 xj=xj_safe+xshift*boxxsize
13231 yj=yj_safe+yshift*boxysize
13232 zj=zj_safe+zshift*boxzsize
13233 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13234 if(dist_temp.lt.dist_init) then
13235 dist_init=dist_temp
13244 if (subchap.eq.1) then
13254 dxj=dc_norm(1,nres+j)
13255 dyj=dc_norm(2,nres+j)
13256 dzj=dc_norm(3,nres+j)
13257 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13259 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13260 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13261 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13262 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13263 if (sss_ele_cut.le.0.0) cycle
13265 if (sss.gt.0.0d0) then
13267 ! Calculate angle-dependent terms of energy and contributions to their
13271 sig=sig0ij*dsqrt(sigsq)
13272 rij_shift=1.0D0/rij-sig+sig0ij
13273 ! for diagnostics; uncomment
13274 ! rij_shift=1.2*sig0ij
13275 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13276 if (rij_shift.le.0.0D0) then
13278 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13279 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13280 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13284 !---------------------------------------------------------------
13285 rij_shift=1.0D0/rij_shift
13286 fac=rij_shift**expon
13289 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13290 eps2der=evdwij*eps3rt
13291 eps3der=evdwij*eps2rt
13292 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13293 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13294 evdwij=evdwij*eps2rt*eps3rt
13295 evdw=evdw+evdwij*sss*sss_ele_cut
13297 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13298 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13299 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13300 restyp(itypi,1),i,restyp(itypj,1),j,&
13301 epsi,sigm,chi1,chi2,chip1,chip2,&
13302 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13303 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13307 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13309 ! if (energy_dec) write (iout,*) &
13310 ! 'evdw',i,j,evdwij,"egb_short"
13312 ! Calculate gradient components.
13313 e1=e1*eps1*eps2rt**2*eps3rt**2
13314 fac=-expon*(e1+evdwij)*rij_shift
13317 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13318 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13319 /sigmaii(itypi,itypj))
13322 ! Calculate the radial part of the gradient
13326 ! Calculate angular part of the gradient.
13327 call sc_grad_scale(sss)
13333 ! write (iout,*) "Number of loop steps in EGB:",ind
13334 !ccc energy_dec=.false.
13336 end subroutine egb_short
13337 !-----------------------------------------------------------------------------
13338 subroutine egbv_long(evdw)
13340 ! This subroutine calculates the interaction energy of nonbonded side chains
13341 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13344 ! implicit real*8 (a-h,o-z)
13345 ! include 'DIMENSIONS'
13346 ! include 'COMMON.GEO'
13347 ! include 'COMMON.VAR'
13348 ! include 'COMMON.LOCAL'
13349 ! include 'COMMON.CHAIN'
13350 ! include 'COMMON.DERIV'
13351 ! include 'COMMON.NAMES'
13352 ! include 'COMMON.INTERACT'
13353 ! include 'COMMON.IOUNITS'
13354 ! include 'COMMON.CALC'
13356 !el integer :: icall
13357 !el common /srutu/ icall
13359 !el local variables
13360 integer :: iint,itypi,itypi1,itypj
13361 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13362 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13364 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13367 ! if (icall.eq.0) lprn=.true.
13369 do i=iatsc_s,iatsc_e
13371 if (itypi.eq.ntyp1) cycle
13372 itypi1=itype(i+1,1)
13376 dxi=dc_norm(1,nres+i)
13377 dyi=dc_norm(2,nres+i)
13378 dzi=dc_norm(3,nres+i)
13379 ! dsci_inv=dsc_inv(itypi)
13380 dsci_inv=vbld_inv(i+nres)
13382 ! Calculate SC interaction energy.
13384 do iint=1,nint_gr(i)
13385 do j=istart(i,iint),iend(i,iint)
13388 if (itypj.eq.ntyp1) cycle
13389 ! dscj_inv=dsc_inv(itypj)
13390 dscj_inv=vbld_inv(j+nres)
13391 sig0ij=sigma(itypi,itypj)
13392 r0ij=r0(itypi,itypj)
13393 chi1=chi(itypi,itypj)
13394 chi2=chi(itypj,itypi)
13401 alf12=0.5D0*(alf1+alf2)
13405 dxj=dc_norm(1,nres+j)
13406 dyj=dc_norm(2,nres+j)
13407 dzj=dc_norm(3,nres+j)
13408 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13411 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13413 if (sss.lt.1.0d0) then
13415 ! Calculate angle-dependent terms of energy and contributions to their
13419 sig=sig0ij*dsqrt(sigsq)
13420 rij_shift=1.0D0/rij-sig+r0ij
13421 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13422 if (rij_shift.le.0.0D0) then
13427 !---------------------------------------------------------------
13428 rij_shift=1.0D0/rij_shift
13429 fac=rij_shift**expon
13430 e1=fac*fac*aa_aq(itypi,itypj)
13431 e2=fac*bb_aq(itypi,itypj)
13432 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13433 eps2der=evdwij*eps3rt
13434 eps3der=evdwij*eps2rt
13435 fac_augm=rrij**expon
13436 e_augm=augm(itypi,itypj)*fac_augm
13437 evdwij=evdwij*eps2rt*eps3rt
13438 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13440 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13441 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13442 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13443 restyp(itypi,1),i,restyp(itypj,1),j,&
13444 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13445 chi1,chi2,chip1,chip2,&
13446 eps1,eps2rt**2,eps3rt**2,&
13447 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13450 ! Calculate gradient components.
13451 e1=e1*eps1*eps2rt**2*eps3rt**2
13452 fac=-expon*(e1+evdwij)*rij_shift
13454 fac=rij*fac-2*expon*rrij*e_augm
13455 ! Calculate the radial part of the gradient
13459 ! Calculate angular part of the gradient.
13460 call sc_grad_scale(1.0d0-sss)
13465 end subroutine egbv_long
13466 !-----------------------------------------------------------------------------
13467 subroutine egbv_short(evdw)
13469 ! This subroutine calculates the interaction energy of nonbonded side chains
13470 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13473 ! implicit real*8 (a-h,o-z)
13474 ! include 'DIMENSIONS'
13475 ! include 'COMMON.GEO'
13476 ! include 'COMMON.VAR'
13477 ! include 'COMMON.LOCAL'
13478 ! include 'COMMON.CHAIN'
13479 ! include 'COMMON.DERIV'
13480 ! include 'COMMON.NAMES'
13481 ! include 'COMMON.INTERACT'
13482 ! include 'COMMON.IOUNITS'
13483 ! include 'COMMON.CALC'
13485 !el integer :: icall
13486 !el common /srutu/ icall
13488 !el local variables
13489 integer :: iint,itypi,itypi1,itypj
13490 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13491 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13493 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13496 ! if (icall.eq.0) lprn=.true.
13498 do i=iatsc_s,iatsc_e
13500 if (itypi.eq.ntyp1) cycle
13501 itypi1=itype(i+1,1)
13505 dxi=dc_norm(1,nres+i)
13506 dyi=dc_norm(2,nres+i)
13507 dzi=dc_norm(3,nres+i)
13508 ! dsci_inv=dsc_inv(itypi)
13509 dsci_inv=vbld_inv(i+nres)
13511 ! Calculate SC interaction energy.
13513 do iint=1,nint_gr(i)
13514 do j=istart(i,iint),iend(i,iint)
13517 if (itypj.eq.ntyp1) cycle
13518 ! dscj_inv=dsc_inv(itypj)
13519 dscj_inv=vbld_inv(j+nres)
13520 sig0ij=sigma(itypi,itypj)
13521 r0ij=r0(itypi,itypj)
13522 chi1=chi(itypi,itypj)
13523 chi2=chi(itypj,itypi)
13530 alf12=0.5D0*(alf1+alf2)
13534 dxj=dc_norm(1,nres+j)
13535 dyj=dc_norm(2,nres+j)
13536 dzj=dc_norm(3,nres+j)
13537 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13540 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13542 if (sss.gt.0.0d0) then
13544 ! Calculate angle-dependent terms of energy and contributions to their
13548 sig=sig0ij*dsqrt(sigsq)
13549 rij_shift=1.0D0/rij-sig+r0ij
13550 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13551 if (rij_shift.le.0.0D0) then
13556 !---------------------------------------------------------------
13557 rij_shift=1.0D0/rij_shift
13558 fac=rij_shift**expon
13559 e1=fac*fac*aa_aq(itypi,itypj)
13560 e2=fac*bb_aq(itypi,itypj)
13561 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13562 eps2der=evdwij*eps3rt
13563 eps3der=evdwij*eps2rt
13564 fac_augm=rrij**expon
13565 e_augm=augm(itypi,itypj)*fac_augm
13566 evdwij=evdwij*eps2rt*eps3rt
13567 evdw=evdw+(evdwij+e_augm)*sss
13569 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13570 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13571 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13572 restyp(itypi,1),i,restyp(itypj,1),j,&
13573 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13574 chi1,chi2,chip1,chip2,&
13575 eps1,eps2rt**2,eps3rt**2,&
13576 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13579 ! Calculate gradient components.
13580 e1=e1*eps1*eps2rt**2*eps3rt**2
13581 fac=-expon*(e1+evdwij)*rij_shift
13583 fac=rij*fac-2*expon*rrij*e_augm
13584 ! Calculate the radial part of the gradient
13588 ! Calculate angular part of the gradient.
13589 call sc_grad_scale(sss)
13594 end subroutine egbv_short
13595 !-----------------------------------------------------------------------------
13596 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13598 ! This subroutine calculates the average interaction energy and its gradient
13599 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13600 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13601 ! The potential depends both on the distance of peptide-group centers and on
13602 ! the orientation of the CA-CA virtual bonds.
13604 ! implicit real*8 (a-h,o-z)
13610 ! include 'DIMENSIONS'
13611 ! include 'COMMON.CONTROL'
13612 ! include 'COMMON.SETUP'
13613 ! include 'COMMON.IOUNITS'
13614 ! include 'COMMON.GEO'
13615 ! include 'COMMON.VAR'
13616 ! include 'COMMON.LOCAL'
13617 ! include 'COMMON.CHAIN'
13618 ! include 'COMMON.DERIV'
13619 ! include 'COMMON.INTERACT'
13620 ! include 'COMMON.CONTACTS'
13621 ! include 'COMMON.TORSION'
13622 ! include 'COMMON.VECTORS'
13623 ! include 'COMMON.FFIELD'
13624 ! include 'COMMON.TIME1'
13625 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13626 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13627 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13628 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13629 real(kind=8),dimension(4) :: muij
13630 !el integer :: num_conti,j1,j2
13631 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13632 !el dz_normi,xmedi,ymedi,zmedi
13633 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13634 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13635 !el num_conti,j1,j2
13636 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13638 real(kind=8) :: scal_el=1.0d0
13640 real(kind=8) :: scal_el=0.5d0
13643 ! 13-go grudnia roku pamietnego...
13644 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13645 0.0d0,1.0d0,0.0d0,&
13646 0.0d0,0.0d0,1.0d0/),shape(unmat))
13647 !el local variables
13649 real(kind=8) :: fac
13650 real(kind=8) :: dxj,dyj,dzj
13651 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13653 ! allocate(num_cont_hb(nres)) !(maxres)
13654 !d write(iout,*) 'In EELEC'
13656 !d write(iout,*) 'Type',i
13657 !d write(iout,*) 'B1',B1(:,i)
13658 !d write(iout,*) 'B2',B2(:,i)
13659 !d write(iout,*) 'CC',CC(:,:,i)
13660 !d write(iout,*) 'DD',DD(:,:,i)
13661 !d write(iout,*) 'EE',EE(:,:,i)
13663 !d call check_vecgrad
13665 if (icheckgrad.eq.1) then
13667 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13669 dc_norm(k,i)=dc(k,i)*fac
13671 ! write (iout,*) 'i',i,' fac',fac
13674 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13675 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13676 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13677 ! call vec_and_deriv
13681 ! print *, "before set matrices"
13683 ! print *,"after set martices"
13685 time_mat=time_mat+MPI_Wtime()-time01
13689 !d write (iout,*) 'i=',i
13691 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13694 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13695 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
13708 !d print '(a)','Enter EELEC'
13709 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
13710 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13711 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13713 gel_loc_loc(i)=0.0d0
13718 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
13720 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
13722 do i=iturn3_start,iturn3_end
13723 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
13724 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
13728 dx_normi=dc_norm(1,i)
13729 dy_normi=dc_norm(2,i)
13730 dz_normi=dc_norm(3,i)
13731 xmedi=c(1,i)+0.5d0*dxi
13732 ymedi=c(2,i)+0.5d0*dyi
13733 zmedi=c(3,i)+0.5d0*dzi
13734 xmedi=dmod(xmedi,boxxsize)
13735 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13736 ymedi=dmod(ymedi,boxysize)
13737 if (ymedi.lt.0) ymedi=ymedi+boxysize
13738 zmedi=dmod(zmedi,boxzsize)
13739 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13741 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
13742 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
13743 num_cont_hb(i)=num_conti
13745 do i=iturn4_start,iturn4_end
13746 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
13747 .or. itype(i+3,1).eq.ntyp1 &
13748 .or. itype(i+4,1).eq.ntyp1) cycle
13752 dx_normi=dc_norm(1,i)
13753 dy_normi=dc_norm(2,i)
13754 dz_normi=dc_norm(3,i)
13755 xmedi=c(1,i)+0.5d0*dxi
13756 ymedi=c(2,i)+0.5d0*dyi
13757 zmedi=c(3,i)+0.5d0*dzi
13758 xmedi=dmod(xmedi,boxxsize)
13759 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13760 ymedi=dmod(ymedi,boxysize)
13761 if (ymedi.lt.0) ymedi=ymedi+boxysize
13762 zmedi=dmod(zmedi,boxzsize)
13763 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13764 num_conti=num_cont_hb(i)
13765 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
13766 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
13767 call eturn4(i,eello_turn4)
13768 num_cont_hb(i)=num_conti
13771 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
13773 do i=iatel_s,iatel_e
13774 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
13778 dx_normi=dc_norm(1,i)
13779 dy_normi=dc_norm(2,i)
13780 dz_normi=dc_norm(3,i)
13781 xmedi=c(1,i)+0.5d0*dxi
13782 ymedi=c(2,i)+0.5d0*dyi
13783 zmedi=c(3,i)+0.5d0*dzi
13784 xmedi=dmod(xmedi,boxxsize)
13785 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13786 ymedi=dmod(ymedi,boxysize)
13787 if (ymedi.lt.0) ymedi=ymedi+boxysize
13788 zmedi=dmod(zmedi,boxzsize)
13789 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13790 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
13791 num_conti=num_cont_hb(i)
13792 do j=ielstart(i),ielend(i)
13793 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
13794 call eelecij_scale(i,j,ees,evdw1,eel_loc)
13796 num_cont_hb(i)=num_conti
13798 ! write (iout,*) "Number of loop steps in EELEC:",ind
13800 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
13801 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
13803 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
13804 !cc eel_loc=eel_loc+eello_turn3
13805 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
13807 end subroutine eelec_scale
13808 !-----------------------------------------------------------------------------
13809 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
13810 ! implicit real*8 (a-h,o-z)
13813 ! include 'DIMENSIONS'
13817 ! include 'COMMON.CONTROL'
13818 ! include 'COMMON.IOUNITS'
13819 ! include 'COMMON.GEO'
13820 ! include 'COMMON.VAR'
13821 ! include 'COMMON.LOCAL'
13822 ! include 'COMMON.CHAIN'
13823 ! include 'COMMON.DERIV'
13824 ! include 'COMMON.INTERACT'
13825 ! include 'COMMON.CONTACTS'
13826 ! include 'COMMON.TORSION'
13827 ! include 'COMMON.VECTORS'
13828 ! include 'COMMON.FFIELD'
13829 ! include 'COMMON.TIME1'
13830 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
13831 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
13832 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13833 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13834 real(kind=8),dimension(4) :: muij
13835 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13836 dist_temp, dist_init,sss_grad
13837 integer xshift,yshift,zshift
13839 !el integer :: num_conti,j1,j2
13840 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13841 !el dz_normi,xmedi,ymedi,zmedi
13842 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13843 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13844 !el num_conti,j1,j2
13845 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13847 real(kind=8) :: scal_el=1.0d0
13849 real(kind=8) :: scal_el=0.5d0
13852 ! 13-go grudnia roku pamietnego...
13853 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13854 0.0d0,1.0d0,0.0d0,&
13855 0.0d0,0.0d0,1.0d0/),shape(unmat))
13856 !el local variables
13857 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
13858 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
13859 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
13860 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
13861 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
13862 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
13863 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
13864 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
13865 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
13866 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
13867 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
13868 ecosam,ecosbm,ecosgm,ghalf,time00
13869 ! integer :: maxconts
13870 ! maxconts = nres/4
13871 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13872 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13873 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13874 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13875 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13876 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13877 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13878 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13879 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
13880 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
13881 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
13882 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
13883 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
13885 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
13886 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
13891 !d write (iout,*) "eelecij",i,j
13895 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13896 aaa=app(iteli,itelj)
13897 bbb=bpp(iteli,itelj)
13898 ael6i=ael6(iteli,itelj)
13899 ael3i=ael3(iteli,itelj)
13903 dx_normj=dc_norm(1,j)
13904 dy_normj=dc_norm(2,j)
13905 dz_normj=dc_norm(3,j)
13906 ! xj=c(1,j)+0.5D0*dxj-xmedi
13907 ! yj=c(2,j)+0.5D0*dyj-ymedi
13908 ! zj=c(3,j)+0.5D0*dzj-zmedi
13909 xj=c(1,j)+0.5D0*dxj
13910 yj=c(2,j)+0.5D0*dyj
13911 zj=c(3,j)+0.5D0*dzj
13912 xj=mod(xj,boxxsize)
13913 if (xj.lt.0) xj=xj+boxxsize
13914 yj=mod(yj,boxysize)
13915 if (yj.lt.0) yj=yj+boxysize
13916 zj=mod(zj,boxzsize)
13917 if (zj.lt.0) zj=zj+boxzsize
13919 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13926 xj=xj_safe+xshift*boxxsize
13927 yj=yj_safe+yshift*boxysize
13928 zj=zj_safe+zshift*boxzsize
13929 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13930 if(dist_temp.lt.dist_init) then
13931 dist_init=dist_temp
13940 if (isubchap.eq.1) then
13951 rij=xj*xj+yj*yj+zj*zj
13955 ! For extracting the short-range part of Evdwpp
13956 sss=sscale(rij/rpp(iteli,itelj))
13957 sss_ele_cut=sscale_ele(rij)
13958 sss_ele_grad=sscagrad_ele(rij)
13959 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
13960 ! sss_ele_cut=1.0d0
13961 ! sss_ele_grad=0.0d0
13962 if (sss_ele_cut.le.0.0) go to 128
13966 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
13967 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
13968 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
13969 fac=cosa-3.0D0*cosb*cosg
13971 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13972 if (j.eq.i+2) ev1=scal_el*ev1
13977 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
13980 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
13981 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
13982 ees=ees+eesij*sss_ele_cut
13983 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
13984 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
13985 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
13986 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
13987 !d & xmedi,ymedi,zmedi,xj,yj,zj
13989 if (energy_dec) then
13990 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13991 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
13995 ! Calculate contributions to the Cartesian gradient.
13998 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
13999 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14005 ! Radial derivatives. First process both termini of the fragment (i,j)
14007 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14008 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14009 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14011 ! ghalf=0.5D0*ggg(k)
14012 ! gelc(k,i)=gelc(k,i)+ghalf
14013 ! gelc(k,j)=gelc(k,j)+ghalf
14015 ! 9/28/08 AL Gradient compotents will be summed only at the end
14017 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14018 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14021 ! Loop over residues i+1 thru j-1.
14025 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14028 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14029 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14030 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14031 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14032 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14033 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14035 ! ghalf=0.5D0*ggg(k)
14036 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14037 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14039 ! 9/28/08 AL Gradient compotents will be summed only at the end
14041 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14042 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14045 ! Loop over residues i+1 thru j-1.
14049 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14053 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14054 facel=(el1+eesij)*sss_ele_cut
14056 fac=-3*rrmij*(facvdw+facvdw+facel)
14061 ! Radial derivatives. First process both termini of the fragment (i,j)
14067 ! ghalf=0.5D0*ggg(k)
14068 ! gelc(k,i)=gelc(k,i)+ghalf
14069 ! gelc(k,j)=gelc(k,j)+ghalf
14071 ! 9/28/08 AL Gradient compotents will be summed only at the end
14073 gelc_long(k,j)=gelc(k,j)+ggg(k)
14074 gelc_long(k,i)=gelc(k,i)-ggg(k)
14077 ! Loop over residues i+1 thru j-1.
14081 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14084 ! 9/28/08 AL Gradient compotents will be summed only at the end
14089 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14090 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14096 ecosa=2.0D0*fac3*fac1+fac4
14099 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14100 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14102 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14103 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14105 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14106 !d & (dcosg(k),k=1,3)
14108 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14111 ! ghalf=0.5D0*ggg(k)
14112 ! gelc(k,i)=gelc(k,i)+ghalf
14113 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14114 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14115 ! gelc(k,j)=gelc(k,j)+ghalf
14116 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14117 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14121 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14125 gelc(k,i)=gelc(k,i) &
14126 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14127 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14129 gelc(k,j)=gelc(k,j) &
14130 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14131 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14133 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14134 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14136 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14137 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14138 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14140 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14141 ! energy of a peptide unit is assumed in the form of a second-order
14142 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14143 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14144 ! are computed for EVERY pair of non-contiguous peptide groups.
14146 if (j.lt.nres-1) then
14157 muij(kkk)=mu(k,i)*mu(l,j)
14160 !d write (iout,*) 'EELEC: i',i,' j',j
14161 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14162 !d write(iout,*) 'muij',muij
14163 ury=scalar(uy(1,i),erij)
14164 urz=scalar(uz(1,i),erij)
14165 vry=scalar(uy(1,j),erij)
14166 vrz=scalar(uz(1,j),erij)
14167 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14168 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14169 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14170 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14171 fac=dsqrt(-ael6i)*r3ij
14176 !d write (iout,'(4i5,4f10.5)')
14177 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14178 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14179 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14180 !d & uy(:,j),uz(:,j)
14181 !d write (iout,'(4f10.5)')
14182 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14183 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14184 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14185 !d write (iout,'(9f10.5/)')
14186 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14187 ! Derivatives of the elements of A in virtual-bond vectors
14188 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14190 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14191 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14192 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14193 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14194 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14195 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14196 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14197 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14198 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14199 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14200 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14201 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14203 ! Compute radial contributions to the gradient
14221 ! Add the contributions coming from er
14224 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14225 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14226 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14227 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14230 ! Derivatives in DC(i)
14231 !grad ghalf1=0.5d0*agg(k,1)
14232 !grad ghalf2=0.5d0*agg(k,2)
14233 !grad ghalf3=0.5d0*agg(k,3)
14234 !grad ghalf4=0.5d0*agg(k,4)
14235 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14236 -3.0d0*uryg(k,2)*vry)!+ghalf1
14237 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14238 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14239 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14240 -3.0d0*urzg(k,2)*vry)!+ghalf3
14241 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14242 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14243 ! Derivatives in DC(i+1)
14244 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14245 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14246 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14247 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14248 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14249 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14250 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14251 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14252 ! Derivatives in DC(j)
14253 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14254 -3.0d0*vryg(k,2)*ury)!+ghalf1
14255 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14256 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14257 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14258 -3.0d0*vryg(k,2)*urz)!+ghalf3
14259 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14260 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14261 ! Derivatives in DC(j+1) or DC(nres-1)
14262 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14263 -3.0d0*vryg(k,3)*ury)
14264 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14265 -3.0d0*vrzg(k,3)*ury)
14266 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14267 -3.0d0*vryg(k,3)*urz)
14268 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14269 -3.0d0*vrzg(k,3)*urz)
14270 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14272 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14285 aggi(k,l)=-aggi(k,l)
14286 aggi1(k,l)=-aggi1(k,l)
14287 aggj(k,l)=-aggj(k,l)
14288 aggj1(k,l)=-aggj1(k,l)
14291 if (j.lt.nres-1) then
14297 aggi(k,l)=-aggi(k,l)
14298 aggi1(k,l)=-aggi1(k,l)
14299 aggj(k,l)=-aggj(k,l)
14300 aggj1(k,l)=-aggj1(k,l)
14311 aggi(k,l)=-aggi(k,l)
14312 aggi1(k,l)=-aggi1(k,l)
14313 aggj(k,l)=-aggj(k,l)
14314 aggj1(k,l)=-aggj1(k,l)
14319 IF (wel_loc.gt.0.0d0) THEN
14320 ! Contribution to the local-electrostatic energy coming from the i-j pair
14321 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14323 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14325 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14326 'eelloc',i,j,eel_loc_ij
14327 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14329 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14330 ! Partial derivatives in virtual-bond dihedral angles gamma
14332 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14333 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14334 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14336 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14337 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14338 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14344 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14346 ggg(l)=(agg(l,1)*muij(1)+ &
14347 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14349 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14351 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14352 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14353 !grad ghalf=0.5d0*ggg(l)
14354 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14355 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14359 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14362 ! Remaining derivatives of eello
14364 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14365 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14368 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14369 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14372 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14373 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14376 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14377 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14382 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14383 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14384 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14385 .and. num_conti.le.maxconts) then
14386 ! write (iout,*) i,j," entered corr"
14388 ! Calculate the contact function. The ith column of the array JCONT will
14389 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14390 ! greater than I). The arrays FACONT and GACONT will contain the values of
14391 ! the contact function and its derivative.
14392 ! r0ij=1.02D0*rpp(iteli,itelj)
14393 ! r0ij=1.11D0*rpp(iteli,itelj)
14394 r0ij=2.20D0*rpp(iteli,itelj)
14395 ! r0ij=1.55D0*rpp(iteli,itelj)
14396 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14397 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14398 if (fcont.gt.0.0D0) then
14399 num_conti=num_conti+1
14400 if (num_conti.gt.maxconts) then
14401 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14402 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14403 ' will skip next contacts for this conf.',num_conti
14405 jcont_hb(num_conti,i)=j
14406 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14407 !d & " jcont_hb",jcont_hb(num_conti,i)
14408 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14409 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14410 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14412 d_cont(num_conti,i)=rij
14413 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14414 ! --- Electrostatic-interaction matrix ---
14415 a_chuj(1,1,num_conti,i)=a22
14416 a_chuj(1,2,num_conti,i)=a23
14417 a_chuj(2,1,num_conti,i)=a32
14418 a_chuj(2,2,num_conti,i)=a33
14419 ! --- Gradient of rij
14421 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14428 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14429 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14430 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14431 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14432 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14437 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14438 ! Calculate contact energies
14440 wij=cosa-3.0D0*cosb*cosg
14443 ! fac3=dsqrt(-ael6i)/r0ij**3
14444 fac3=dsqrt(-ael6i)*r3ij
14445 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14446 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14447 if (ees0tmp.gt.0) then
14448 ees0pij=dsqrt(ees0tmp)
14452 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14453 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14454 if (ees0tmp.gt.0) then
14455 ees0mij=dsqrt(ees0tmp)
14460 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14463 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14466 ! Diagnostics. Comment out or remove after debugging!
14467 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14468 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14469 ! ees0m(num_conti,i)=0.0D0
14471 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14472 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14473 ! Angular derivatives of the contact function
14474 ees0pij1=fac3/ees0pij
14475 ees0mij1=fac3/ees0mij
14476 fac3p=-3.0D0*fac3*rrmij
14477 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14478 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14480 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14481 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14482 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14483 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14484 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14485 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14486 ecosap=ecosa1+ecosa2
14487 ecosbp=ecosb1+ecosb2
14488 ecosgp=ecosg1+ecosg2
14489 ecosam=ecosa1-ecosa2
14490 ecosbm=ecosb1-ecosb2
14491 ecosgm=ecosg1-ecosg2
14500 facont_hb(num_conti,i)=fcont
14501 fprimcont=fprimcont/rij
14502 !d facont_hb(num_conti,i)=1.0D0
14503 ! Following line is for diagnostics.
14506 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14507 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14510 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14511 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14513 ! gggp(1)=gggp(1)+ees0pijp*xj
14514 ! gggp(2)=gggp(2)+ees0pijp*yj
14515 ! gggp(3)=gggp(3)+ees0pijp*zj
14516 ! gggm(1)=gggm(1)+ees0mijp*xj
14517 ! gggm(2)=gggm(2)+ees0mijp*yj
14518 ! gggm(3)=gggm(3)+ees0mijp*zj
14519 gggp(1)=gggp(1)+ees0pijp*xj &
14520 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14521 gggp(2)=gggp(2)+ees0pijp*yj &
14522 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14523 gggp(3)=gggp(3)+ees0pijp*zj &
14524 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14526 gggm(1)=gggm(1)+ees0mijp*xj &
14527 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14529 gggm(2)=gggm(2)+ees0mijp*yj &
14530 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14532 gggm(3)=gggm(3)+ees0mijp*zj &
14533 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14535 ! Derivatives due to the contact function
14536 gacont_hbr(1,num_conti,i)=fprimcont*xj
14537 gacont_hbr(2,num_conti,i)=fprimcont*yj
14538 gacont_hbr(3,num_conti,i)=fprimcont*zj
14541 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14542 ! following the change of gradient-summation algorithm.
14544 !grad ghalfp=0.5D0*gggp(k)
14545 !grad ghalfm=0.5D0*gggm(k)
14546 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14547 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14548 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14549 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14550 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14551 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14552 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14553 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14554 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14555 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14556 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14557 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14558 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14559 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14560 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14561 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14562 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14565 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14566 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14567 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14570 gacontp_hb3(k,num_conti,i)=gggp(k) &
14573 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14574 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14575 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14578 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14579 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14580 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14583 gacontm_hb3(k,num_conti,i)=gggm(k) &
14588 endif ! num_conti.le.maxconts
14591 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14594 ghalf=0.5d0*agg(l,k)
14595 aggi(l,k)=aggi(l,k)+ghalf
14596 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14597 aggj(l,k)=aggj(l,k)+ghalf
14600 if (j.eq.nres-1 .and. i.lt.j-2) then
14603 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14609 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14611 end subroutine eelecij_scale
14612 !-----------------------------------------------------------------------------
14613 subroutine evdwpp_short(evdw1)
14617 ! implicit real*8 (a-h,o-z)
14618 ! include 'DIMENSIONS'
14619 ! include 'COMMON.CONTROL'
14620 ! include 'COMMON.IOUNITS'
14621 ! include 'COMMON.GEO'
14622 ! include 'COMMON.VAR'
14623 ! include 'COMMON.LOCAL'
14624 ! include 'COMMON.CHAIN'
14625 ! include 'COMMON.DERIV'
14626 ! include 'COMMON.INTERACT'
14627 ! include 'COMMON.CONTACTS'
14628 ! include 'COMMON.TORSION'
14629 ! include 'COMMON.VECTORS'
14630 ! include 'COMMON.FFIELD'
14631 real(kind=8),dimension(3) :: ggg
14632 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14634 real(kind=8) :: scal_el=1.0d0
14636 real(kind=8) :: scal_el=0.5d0
14638 !el local variables
14639 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14640 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14641 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14642 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14643 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14644 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14645 dist_temp, dist_init,sss_grad
14646 integer xshift,yshift,zshift
14650 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14651 ! & " iatel_e_vdw",iatel_e_vdw
14653 do i=iatel_s_vdw,iatel_e_vdw
14654 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14658 dx_normi=dc_norm(1,i)
14659 dy_normi=dc_norm(2,i)
14660 dz_normi=dc_norm(3,i)
14661 xmedi=c(1,i)+0.5d0*dxi
14662 ymedi=c(2,i)+0.5d0*dyi
14663 zmedi=c(3,i)+0.5d0*dzi
14664 xmedi=dmod(xmedi,boxxsize)
14665 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14666 ymedi=dmod(ymedi,boxysize)
14667 if (ymedi.lt.0) ymedi=ymedi+boxysize
14668 zmedi=dmod(zmedi,boxzsize)
14669 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14671 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14672 ! & ' ielend',ielend_vdw(i)
14674 do j=ielstart_vdw(i),ielend_vdw(i)
14675 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14679 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14680 aaa=app(iteli,itelj)
14681 bbb=bpp(iteli,itelj)
14685 dx_normj=dc_norm(1,j)
14686 dy_normj=dc_norm(2,j)
14687 dz_normj=dc_norm(3,j)
14688 ! xj=c(1,j)+0.5D0*dxj-xmedi
14689 ! yj=c(2,j)+0.5D0*dyj-ymedi
14690 ! zj=c(3,j)+0.5D0*dzj-zmedi
14691 xj=c(1,j)+0.5D0*dxj
14692 yj=c(2,j)+0.5D0*dyj
14693 zj=c(3,j)+0.5D0*dzj
14694 xj=mod(xj,boxxsize)
14695 if (xj.lt.0) xj=xj+boxxsize
14696 yj=mod(yj,boxysize)
14697 if (yj.lt.0) yj=yj+boxysize
14698 zj=mod(zj,boxzsize)
14699 if (zj.lt.0) zj=zj+boxzsize
14701 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14708 xj=xj_safe+xshift*boxxsize
14709 yj=yj_safe+yshift*boxysize
14710 zj=zj_safe+zshift*boxzsize
14711 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14712 if(dist_temp.lt.dist_init) then
14713 dist_init=dist_temp
14722 if (isubchap.eq.1) then
14733 rij=xj*xj+yj*yj+zj*zj
14736 sss=sscale(rij/rpp(iteli,itelj))
14737 sss_ele_cut=sscale_ele(rij)
14738 sss_ele_grad=sscagrad_ele(rij)
14739 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14740 if (sss_ele_cut.le.0.0) cycle
14741 if (sss.gt.0.0d0) then
14746 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14747 if (j.eq.i+2) ev1=scal_el*ev1
14750 if (energy_dec) then
14751 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14753 evdw1=evdw1+evdwij*sss*sss_ele_cut
14755 ! Calculate contributions to the Cartesian gradient.
14757 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
14761 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
14762 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14763 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
14764 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14765 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
14766 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14769 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14770 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14776 end subroutine evdwpp_short
14777 !-----------------------------------------------------------------------------
14778 subroutine escp_long(evdw2,evdw2_14)
14780 ! This subroutine calculates the excluded-volume interaction energy between
14781 ! peptide-group centers and side chains and its gradient in virtual-bond and
14782 ! side-chain vectors.
14784 ! implicit real*8 (a-h,o-z)
14785 ! include 'DIMENSIONS'
14786 ! include 'COMMON.GEO'
14787 ! include 'COMMON.VAR'
14788 ! include 'COMMON.LOCAL'
14789 ! include 'COMMON.CHAIN'
14790 ! include 'COMMON.DERIV'
14791 ! include 'COMMON.INTERACT'
14792 ! include 'COMMON.FFIELD'
14793 ! include 'COMMON.IOUNITS'
14794 ! include 'COMMON.CONTROL'
14795 real(kind=8),dimension(3) :: ggg
14796 !el local variables
14797 integer :: i,iint,j,k,iteli,itypj,subchap
14798 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14799 real(kind=8) :: evdw2,evdw2_14,evdwij
14800 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14801 dist_temp, dist_init
14805 !d print '(a)','Enter ESCP'
14806 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14807 do i=iatscp_s,iatscp_e
14808 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14810 xi=0.5D0*(c(1,i)+c(1,i+1))
14811 yi=0.5D0*(c(2,i)+c(2,i+1))
14812 zi=0.5D0*(c(3,i)+c(3,i+1))
14813 xi=mod(xi,boxxsize)
14814 if (xi.lt.0) xi=xi+boxxsize
14815 yi=mod(yi,boxysize)
14816 if (yi.lt.0) yi=yi+boxysize
14817 zi=mod(zi,boxzsize)
14818 if (zi.lt.0) zi=zi+boxzsize
14820 do iint=1,nscp_gr(i)
14822 do j=iscpstart(i,iint),iscpend(i,iint)
14824 if (itypj.eq.ntyp1) cycle
14825 ! Uncomment following three lines for SC-p interactions
14826 ! xj=c(1,nres+j)-xi
14827 ! yj=c(2,nres+j)-yi
14828 ! zj=c(3,nres+j)-zi
14829 ! Uncomment following three lines for Ca-p interactions
14833 xj=mod(xj,boxxsize)
14834 if (xj.lt.0) xj=xj+boxxsize
14835 yj=mod(yj,boxysize)
14836 if (yj.lt.0) yj=yj+boxysize
14837 zj=mod(zj,boxzsize)
14838 if (zj.lt.0) zj=zj+boxzsize
14839 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14847 xj=xj_safe+xshift*boxxsize
14848 yj=yj_safe+yshift*boxysize
14849 zj=zj_safe+zshift*boxzsize
14850 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14851 if(dist_temp.lt.dist_init) then
14852 dist_init=dist_temp
14861 if (subchap.eq.1) then
14870 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14872 rij=dsqrt(1.0d0/rrij)
14873 sss_ele_cut=sscale_ele(rij)
14874 sss_ele_grad=sscagrad_ele(rij)
14875 ! print *,sss_ele_cut,sss_ele_grad,&
14876 ! (rij),r_cut_ele,rlamb_ele
14877 if (sss_ele_cut.le.0.0) cycle
14878 sss=sscale((rij/rscp(itypj,iteli)))
14879 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14880 if (sss.lt.1.0d0) then
14883 e1=fac*fac*aad(itypj,iteli)
14884 e2=fac*bad(itypj,iteli)
14885 if (iabs(j-i) .le. 2) then
14888 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
14891 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
14892 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
14893 'evdw2',i,j,sss,evdwij
14895 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
14897 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
14898 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
14899 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
14903 ! Uncomment following three lines for SC-p interactions
14905 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14907 ! Uncomment following line for SC-p interactions
14908 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14910 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
14911 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
14920 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
14921 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
14922 gradx_scp(j,i)=expon*gradx_scp(j,i)
14925 !******************************************************************************
14929 ! To save time the factor EXPON has been extracted from ALL components
14930 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
14933 !******************************************************************************
14935 end subroutine escp_long
14936 !-----------------------------------------------------------------------------
14937 subroutine escp_short(evdw2,evdw2_14)
14939 ! This subroutine calculates the excluded-volume interaction energy between
14940 ! peptide-group centers and side chains and its gradient in virtual-bond and
14941 ! side-chain vectors.
14943 ! implicit real*8 (a-h,o-z)
14944 ! include 'DIMENSIONS'
14945 ! include 'COMMON.GEO'
14946 ! include 'COMMON.VAR'
14947 ! include 'COMMON.LOCAL'
14948 ! include 'COMMON.CHAIN'
14949 ! include 'COMMON.DERIV'
14950 ! include 'COMMON.INTERACT'
14951 ! include 'COMMON.FFIELD'
14952 ! include 'COMMON.IOUNITS'
14953 ! include 'COMMON.CONTROL'
14954 real(kind=8),dimension(3) :: ggg
14955 !el local variables
14956 integer :: i,iint,j,k,iteli,itypj,subchap
14957 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14958 real(kind=8) :: evdw2,evdw2_14,evdwij
14959 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14960 dist_temp, dist_init
14964 !d print '(a)','Enter ESCP'
14965 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14966 do i=iatscp_s,iatscp_e
14967 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14969 xi=0.5D0*(c(1,i)+c(1,i+1))
14970 yi=0.5D0*(c(2,i)+c(2,i+1))
14971 zi=0.5D0*(c(3,i)+c(3,i+1))
14972 xi=mod(xi,boxxsize)
14973 if (xi.lt.0) xi=xi+boxxsize
14974 yi=mod(yi,boxysize)
14975 if (yi.lt.0) yi=yi+boxysize
14976 zi=mod(zi,boxzsize)
14977 if (zi.lt.0) zi=zi+boxzsize
14979 do iint=1,nscp_gr(i)
14981 do j=iscpstart(i,iint),iscpend(i,iint)
14983 if (itypj.eq.ntyp1) cycle
14984 ! Uncomment following three lines for SC-p interactions
14985 ! xj=c(1,nres+j)-xi
14986 ! yj=c(2,nres+j)-yi
14987 ! zj=c(3,nres+j)-zi
14988 ! Uncomment following three lines for Ca-p interactions
14995 xj=mod(xj,boxxsize)
14996 if (xj.lt.0) xj=xj+boxxsize
14997 yj=mod(yj,boxysize)
14998 if (yj.lt.0) yj=yj+boxysize
14999 zj=mod(zj,boxzsize)
15000 if (zj.lt.0) zj=zj+boxzsize
15001 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15009 xj=xj_safe+xshift*boxxsize
15010 yj=yj_safe+yshift*boxysize
15011 zj=zj_safe+zshift*boxzsize
15012 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15013 if(dist_temp.lt.dist_init) then
15014 dist_init=dist_temp
15023 if (subchap.eq.1) then
15033 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15034 rij=dsqrt(1.0d0/rrij)
15035 sss_ele_cut=sscale_ele(rij)
15036 sss_ele_grad=sscagrad_ele(rij)
15037 ! print *,sss_ele_cut,sss_ele_grad,&
15038 ! (rij),r_cut_ele,rlamb_ele
15039 if (sss_ele_cut.le.0.0) cycle
15040 sss=sscale(rij/rscp(itypj,iteli))
15041 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15042 if (sss.gt.0.0d0) then
15045 e1=fac*fac*aad(itypj,iteli)
15046 e2=fac*bad(itypj,iteli)
15047 if (iabs(j-i) .le. 2) then
15050 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15053 evdw2=evdw2+evdwij*sss*sss_ele_cut
15054 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15055 'evdw2',i,j,sss,evdwij
15057 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15059 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15060 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15061 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15066 ! Uncomment following three lines for SC-p interactions
15068 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15070 ! Uncomment following line for SC-p interactions
15071 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15073 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15074 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15083 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15084 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15085 gradx_scp(j,i)=expon*gradx_scp(j,i)
15088 !******************************************************************************
15092 ! To save time the factor EXPON has been extracted from ALL components
15093 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15096 !******************************************************************************
15098 end subroutine escp_short
15099 !-----------------------------------------------------------------------------
15100 ! energy_p_new-sep_barrier.F
15101 !-----------------------------------------------------------------------------
15102 subroutine sc_grad_scale(scalfac)
15103 ! implicit real*8 (a-h,o-z)
15105 ! include 'DIMENSIONS'
15106 ! include 'COMMON.CHAIN'
15107 ! include 'COMMON.DERIV'
15108 ! include 'COMMON.CALC'
15109 ! include 'COMMON.IOUNITS'
15110 real(kind=8),dimension(3) :: dcosom1,dcosom2
15111 real(kind=8) :: scalfac
15112 !el local variables
15113 ! integer :: i,j,k,l
15115 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15116 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15117 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15118 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15122 ! eom12=evdwij*eps1_om12
15124 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15125 ! & " sigder",sigder
15126 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15127 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15129 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15130 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15133 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15136 ! write (iout,*) "gg",(gg(k),k=1,3)
15138 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15139 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15140 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15142 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15143 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15144 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15146 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15147 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15148 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15149 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15152 ! Calculate the components of the gradient in DC and X
15155 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15156 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15159 end subroutine sc_grad_scale
15160 !-----------------------------------------------------------------------------
15161 ! energy_split-sep.F
15162 !-----------------------------------------------------------------------------
15163 subroutine etotal_long(energia)
15165 ! Compute the long-range slow-varying contributions to the energy
15167 ! implicit real*8 (a-h,o-z)
15168 ! include 'DIMENSIONS'
15169 use MD_data, only: totT,usampl,eq_time
15173 !MS$ATTRIBUTES C :: proc_proc
15178 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15180 ! include 'COMMON.SETUP'
15181 ! include 'COMMON.IOUNITS'
15182 ! include 'COMMON.FFIELD'
15183 ! include 'COMMON.DERIV'
15184 ! include 'COMMON.INTERACT'
15185 ! include 'COMMON.SBRIDGE'
15186 ! include 'COMMON.CHAIN'
15187 ! include 'COMMON.VAR'
15188 ! include 'COMMON.LOCAL'
15189 ! include 'COMMON.MD'
15190 real(kind=8),dimension(0:n_ene) :: energia
15191 !el local variables
15192 integer :: i,n_corr,n_corr1,ierror,ierr
15193 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15194 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15195 ecorr,ecorr5,ecorr6,eturn6,time00
15196 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15197 !elwrite(iout,*)"in etotal long"
15199 if (modecalc.eq.12.or.modecalc.eq.14) then
15201 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15203 call int_from_cart1(.false.)
15206 !elwrite(iout,*)"in etotal long"
15209 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15210 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15212 if (nfgtasks.gt.1) then
15214 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15215 if (fg_rank.eq.0) then
15216 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15217 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15219 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15220 ! FG slaves as WEIGHTS array.
15227 weights_(7)=wel_loc
15230 weights_(10)=wturn6
15232 weights_(12)=wscloc
15234 weights_(14)=wtor_d
15235 weights_(15)=wstrain
15236 weights_(16)=wvdwpp
15238 weights_(18)=scal14
15239 weights_(21)=wsccor
15240 ! FG Master broadcasts the WEIGHTS_ array
15241 call MPI_Bcast(weights_(1),n_ene,&
15242 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15244 ! FG slaves receive the WEIGHTS array
15245 call MPI_Bcast(weights(1),n_ene,&
15246 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15261 wstrain=weights(15)
15267 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15269 time_Bcast=time_Bcast+MPI_Wtime()-time00
15270 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15271 ! call chainbuild_cart
15272 ! call int_from_cart1(.false.)
15274 ! write (iout,*) 'Processor',myrank,
15275 ! & ' calling etotal_short ipot=',ipot
15277 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15279 !d print *,'nnt=',nnt,' nct=',nct
15281 !elwrite(iout,*)"in etotal long"
15282 ! Compute the side-chain and electrostatic interaction energy
15284 goto (101,102,103,104,105,106) ipot
15285 ! Lennard-Jones potential.
15286 101 call elj_long(evdw)
15287 !d print '(a)','Exit ELJ'
15289 ! Lennard-Jones-Kihara potential (shifted).
15290 102 call eljk_long(evdw)
15292 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15293 103 call ebp_long(evdw)
15295 ! Gay-Berne potential (shifted LJ, angular dependence).
15296 104 call egb_long(evdw)
15298 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15299 105 call egbv_long(evdw)
15301 ! Soft-sphere potential
15302 106 call e_softsphere(evdw)
15304 ! Calculate electrostatic (H-bonding) energy of the main chain.
15308 if (ipot.lt.6) then
15310 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15311 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15312 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15313 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15315 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15316 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15317 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15318 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15320 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15329 ! write (iout,*) "Soft-spheer ELEC potential"
15330 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15334 ! Calculate excluded-volume interaction energy between peptide groups
15337 if (ipot.lt.6) then
15338 if(wscp.gt.0d0) then
15339 call escp_long(evdw2,evdw2_14)
15345 call escp_soft_sphere(evdw2,evdw2_14)
15348 ! 12/1/95 Multi-body terms
15352 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15353 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15354 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15355 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15356 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15363 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15364 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15367 ! If performing constraint dynamics, call the constraint energy
15368 ! after the equilibration time
15369 if(usampl.and.totT.gt.eq_time) then
15384 energia(2)=evdw2-evdw2_14
15385 energia(18)=evdw2_14
15394 energia(3)=ees+evdw1
15401 energia(8)=eello_turn3
15402 energia(9)=eello_turn4
15404 energia(20)=Uconst+Uconst_back
15405 call sum_energy(energia,.true.)
15406 ! write (iout,*) "Exit ETOTAL_LONG"
15409 end subroutine etotal_long
15410 !-----------------------------------------------------------------------------
15411 subroutine etotal_short(energia)
15413 ! Compute the short-range fast-varying contributions to the energy
15415 ! implicit real*8 (a-h,o-z)
15416 ! include 'DIMENSIONS'
15420 !MS$ATTRIBUTES C :: proc_proc
15425 integer :: ierror,ierr
15426 real(kind=8),dimension(n_ene) :: weights_
15427 real(kind=8) :: time00
15429 ! include 'COMMON.SETUP'
15430 ! include 'COMMON.IOUNITS'
15431 ! include 'COMMON.FFIELD'
15432 ! include 'COMMON.DERIV'
15433 ! include 'COMMON.INTERACT'
15434 ! include 'COMMON.SBRIDGE'
15435 ! include 'COMMON.CHAIN'
15436 ! include 'COMMON.VAR'
15437 ! include 'COMMON.LOCAL'
15438 real(kind=8),dimension(0:n_ene) :: energia
15439 !el local variables
15441 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15442 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15445 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15447 if (modecalc.eq.12.or.modecalc.eq.14) then
15449 if (fg_rank.eq.0) call int_from_cart1(.false.)
15451 call int_from_cart1(.false.)
15455 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15456 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15458 if (nfgtasks.gt.1) then
15460 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15461 if (fg_rank.eq.0) then
15462 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15463 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15465 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15466 ! FG slaves as WEIGHTS array.
15473 weights_(7)=wel_loc
15476 weights_(10)=wturn6
15478 weights_(12)=wscloc
15480 weights_(14)=wtor_d
15481 weights_(15)=wstrain
15482 weights_(16)=wvdwpp
15484 weights_(18)=scal14
15485 weights_(21)=wsccor
15486 ! FG Master broadcasts the WEIGHTS_ array
15487 call MPI_Bcast(weights_(1),n_ene,&
15488 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15490 ! FG slaves receive the WEIGHTS array
15491 call MPI_Bcast(weights(1),n_ene,&
15492 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15507 wstrain=weights(15)
15513 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15514 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15516 ! write (iout,*) "Processor",myrank," BROADCAST c"
15517 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15519 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15520 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15522 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15523 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15525 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15526 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15528 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15529 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15531 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15532 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15534 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15535 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15537 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15538 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15540 time_Bcast=time_Bcast+MPI_Wtime()-time00
15541 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15543 ! write (iout,*) 'Processor',myrank,
15544 ! & ' calling etotal_short ipot=',ipot
15546 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15548 ! call int_from_cart1(.false.)
15550 ! Compute the side-chain and electrostatic interaction energy
15552 goto (101,102,103,104,105,106) ipot
15553 ! Lennard-Jones potential.
15554 101 call elj_short(evdw)
15555 !d print '(a)','Exit ELJ'
15557 ! Lennard-Jones-Kihara potential (shifted).
15558 102 call eljk_short(evdw)
15560 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15561 103 call ebp_short(evdw)
15563 ! Gay-Berne potential (shifted LJ, angular dependence).
15564 104 call egb_short(evdw)
15566 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15567 105 call egbv_short(evdw)
15569 ! Soft-sphere potential - already dealt with in the long-range part
15571 ! 106 call e_softsphere_short(evdw)
15573 ! Calculate electrostatic (H-bonding) energy of the main chain.
15577 ! Calculate the short-range part of Evdwpp
15579 call evdwpp_short(evdw1)
15581 ! Calculate the short-range part of ESCp
15583 if (ipot.lt.6) then
15584 call escp_short(evdw2,evdw2_14)
15587 ! Calculate the bond-stretching energy
15591 ! Calculate the disulfide-bridge and other energy and the contributions
15592 ! from other distance constraints.
15595 ! Calculate the virtual-bond-angle energy.
15597 call ebend(ebe,ethetacnstr)
15599 ! Calculate the SC local energy.
15604 ! Calculate the virtual-bond torsional energy.
15606 call etor(etors,edihcnstr)
15608 ! 6/23/01 Calculate double-torsional energy
15610 call etor_d(etors_d)
15612 ! 21/5/07 Calculate local sicdechain correlation energy
15614 if (wsccor.gt.0.0d0) then
15615 call eback_sc_corr(esccor)
15620 ! Put energy components into an array
15627 energia(2)=evdw2-evdw2_14
15628 energia(18)=evdw2_14
15641 energia(14)=etors_d
15644 energia(19)=edihcnstr
15646 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15648 call sum_energy(energia,.true.)
15649 ! write (iout,*) "Exit ETOTAL_SHORT"
15652 end subroutine etotal_short
15653 !-----------------------------------------------------------------------------
15655 !-----------------------------------------------------------------------------
15656 real(kind=8) function gnmr1(y,ymin,ymax)
15658 real(kind=8) :: y,ymin,ymax
15659 real(kind=8) :: wykl=4.0d0
15660 if (y.lt.ymin) then
15661 gnmr1=(ymin-y)**wykl/wykl
15662 else if (y.gt.ymax) then
15663 gnmr1=(y-ymax)**wykl/wykl
15669 !-----------------------------------------------------------------------------
15670 real(kind=8) function gnmr1prim(y,ymin,ymax)
15672 real(kind=8) :: y,ymin,ymax
15673 real(kind=8) :: wykl=4.0d0
15674 if (y.lt.ymin) then
15675 gnmr1prim=-(ymin-y)**(wykl-1)
15676 else if (y.gt.ymax) then
15677 gnmr1prim=(y-ymax)**(wykl-1)
15682 end function gnmr1prim
15683 !----------------------------------------------------------------------------
15684 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15685 real(kind=8) y,ymin,ymax,sigma
15686 real(kind=8) wykl /4.0d0/
15687 if (y.lt.ymin) then
15688 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
15689 else if (y.gt.ymax) then
15690 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
15695 end function rlornmr1
15696 !------------------------------------------------------------------------------
15697 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
15698 real(kind=8) y,ymin,ymax,sigma
15699 real(kind=8) wykl /4.0d0/
15700 if (y.lt.ymin) then
15701 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
15702 ((ymin-y)**wykl+sigma**wykl)**2
15703 else if (y.gt.ymax) then
15704 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
15705 ((y-ymax)**wykl+sigma**wykl)**2
15710 end function rlornmr1prim
15712 real(kind=8) function harmonic(y,ymax)
15714 real(kind=8) :: y,ymax
15715 real(kind=8) :: wykl=2.0d0
15716 harmonic=(y-ymax)**wykl
15718 end function harmonic
15719 !-----------------------------------------------------------------------------
15720 real(kind=8) function harmonicprim(y,ymax)
15721 real(kind=8) :: y,ymin,ymax
15722 real(kind=8) :: wykl=2.0d0
15723 harmonicprim=(y-ymax)*wykl
15725 end function harmonicprim
15726 !-----------------------------------------------------------------------------
15728 !-----------------------------------------------------------------------------
15729 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
15731 use io_base, only:intout,briefout
15732 ! implicit real*8 (a-h,o-z)
15733 ! include 'DIMENSIONS'
15734 ! include 'COMMON.CHAIN'
15735 ! include 'COMMON.DERIV'
15736 ! include 'COMMON.VAR'
15737 ! include 'COMMON.INTERACT'
15738 ! include 'COMMON.FFIELD'
15739 ! include 'COMMON.MD'
15740 ! include 'COMMON.IOUNITS'
15741 real(kind=8),external :: ufparm
15742 integer :: uiparm(1)
15743 real(kind=8) :: urparm(1)
15744 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
15745 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
15746 integer :: n,nf,ind,ind1,i,k,j
15748 ! This subroutine calculates total internal coordinate gradient.
15749 ! Depending on the number of function evaluations, either whole energy
15750 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
15751 ! internal coordinates are reevaluated or only the cartesian-in-internal
15752 ! coordinate derivatives are evaluated. The subroutine was designed to work
15758 !d print *,'grad',nf,icg
15759 if (nf-nfl+1) 20,30,40
15760 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
15761 ! write (iout,*) 'grad 20'
15762 if (nf.eq.0) return
15764 30 call var_to_geom(n,x)
15766 ! write (iout,*) 'grad 30'
15768 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
15771 ! write (iout,*) 'grad 40'
15772 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
15774 ! Convert the Cartesian gradient into internal-coordinate gradient.
15784 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
15786 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
15789 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
15795 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
15797 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
15798 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
15801 if (i.gt.1) g(i-1)=gphii
15802 if (n.gt.nphi) g(nphi+i)=gthetai
15804 if (n.le.nphi+ntheta) goto 10
15806 if (itype(i,1).ne.10) then
15810 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
15813 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
15815 g(ialph(i,1))=galphai
15816 g(ialph(i,1)+nside)=gomegai
15820 ! Add the components corresponding to local energy terms.
15824 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
15825 g(i)=g(i)+gloc(i,icg)
15827 ! Uncomment following three lines for diagnostics.
15829 !elwrite(iout,*) "in gradient after calling intout"
15830 !d call briefout(0,0.0d0)
15831 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
15833 end subroutine gradient
15834 !-----------------------------------------------------------------------------
15835 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
15838 ! implicit real*8 (a-h,o-z)
15839 ! include 'DIMENSIONS'
15840 ! include 'COMMON.DERIV'
15841 ! include 'COMMON.IOUNITS'
15842 ! include 'COMMON.GEO'
15845 !el common /chuju/ jjj
15846 real(kind=8) :: energia(0:n_ene)
15847 integer :: uiparm(1)
15848 real(kind=8) :: urparm(1)
15850 real(kind=8),external :: ufparm
15851 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
15852 ! if (jjj.gt.0) then
15853 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15857 !d print *,'func',nf,nfl,icg
15858 call var_to_geom(n,x)
15861 !d write (iout,*) 'ETOTAL called from FUNC'
15862 call etotal(energia)
15865 ! if (jjj.gt.0) then
15866 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15867 ! write (iout,*) 'f=',etot
15871 end subroutine func
15872 !-----------------------------------------------------------------------------
15873 subroutine cartgrad
15874 ! implicit real*8 (a-h,o-z)
15875 ! include 'DIMENSIONS'
15877 use MD_data, only: totT,usampl,eq_time
15881 ! include 'COMMON.CHAIN'
15882 ! include 'COMMON.DERIV'
15883 ! include 'COMMON.VAR'
15884 ! include 'COMMON.INTERACT'
15885 ! include 'COMMON.FFIELD'
15886 ! include 'COMMON.MD'
15887 ! include 'COMMON.IOUNITS'
15888 ! include 'COMMON.TIME1'
15892 ! This subrouting calculates total Cartesian coordinate gradient.
15893 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
15903 !el write (iout,*) "After sum_gradient"
15905 !el write (iout,*) "After sum_gradient"
15907 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
15908 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
15911 ! If performing constraint dynamics, add the gradients of the constraint energy
15912 if(usampl.and.totT.gt.eq_time) then
15915 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
15916 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
15920 gloc(i,icg)=gloc(i,icg)+dugamma(i)
15923 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
15926 !elwrite (iout,*) "After sum_gradient"
15931 !elwrite (iout,*) "After sum_gradient"
15933 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
15935 ! call checkintcartgrad
15936 ! write(iout,*) 'calling int_to_cart'
15938 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
15942 gcart(j,i)=gradc(j,i,icg)
15943 gxcart(j,i)=gradx(j,i,icg)
15946 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
15947 (gxcart(j,i),j=1,3),gloc(i,icg)
15955 time_inttocart=time_inttocart+MPI_Wtime()-time01
15958 write (iout,*) "gcart and gxcart after int_to_cart"
15960 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
15961 (gxcart(j,i),j=1,3)
15966 write (iout,*) "CARGRAD"
15970 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15971 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15973 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
15974 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
15976 ! Correction: dummy residues
15979 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
15980 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
15983 if (nct.lt.nres) then
15985 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
15986 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
15991 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
15995 end subroutine cartgrad
15996 !-----------------------------------------------------------------------------
15997 subroutine zerograd
15998 ! implicit real*8 (a-h,o-z)
15999 ! include 'DIMENSIONS'
16000 ! include 'COMMON.DERIV'
16001 ! include 'COMMON.CHAIN'
16002 ! include 'COMMON.VAR'
16003 ! include 'COMMON.MD'
16004 ! include 'COMMON.SCCOR'
16006 !el local variables
16007 integer :: i,j,intertyp,k
16008 ! Initialize Cartesian-coordinate gradient
16010 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16011 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16013 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16014 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16015 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16016 ! allocate(gradcorr_long(3,nres))
16017 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16018 ! allocate(gcorr6_turn_long(3,nres))
16019 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16021 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16023 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16024 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16026 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16027 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16029 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16030 ! allocate(gscloc(3,nres)) !(3,maxres)
16031 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16035 ! common /deriv_scloc/
16036 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16037 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16038 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16040 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16044 ! gradc(j,i,icg)=0.0d0
16045 ! gradx(j,i,icg)=0.0d0
16047 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16048 !elwrite(iout,*) "icg",icg
16052 gradx_scp(j,i)=0.0D0
16054 gvdwc_scp(j,i)=0.0D0
16055 gvdwc_scpp(j,i)=0.0d0
16057 gelc_long(j,i)=0.0D0
16062 gel_loc_long(j,i)=0.0d0
16065 gcorr3_turn(j,i)=0.0d0
16066 gcorr4_turn(j,i)=0.0d0
16067 gradcorr(j,i)=0.0d0
16068 gradcorr_long(j,i)=0.0d0
16069 gradcorr5_long(j,i)=0.0d0
16070 gradcorr6_long(j,i)=0.0d0
16071 gcorr6_turn_long(j,i)=0.0d0
16072 gradcorr5(j,i)=0.0d0
16073 gradcorr6(j,i)=0.0d0
16074 gcorr6_turn(j,i)=0.0d0
16077 gradc(j,i,icg)=0.0d0
16078 gradx(j,i,icg)=0.0d0
16081 gliptran(j,i)=0.0d0
16082 gliptranx(j,i)=0.0d0
16083 gliptranc(j,i)=0.0d0
16084 gshieldx(j,i)=0.0d0
16085 gshieldc(j,i)=0.0d0
16086 gshieldc_loc(j,i)=0.0d0
16087 gshieldx_ec(j,i)=0.0d0
16088 gshieldc_ec(j,i)=0.0d0
16089 gshieldc_loc_ec(j,i)=0.0d0
16090 gshieldx_t3(j,i)=0.0d0
16091 gshieldc_t3(j,i)=0.0d0
16092 gshieldc_loc_t3(j,i)=0.0d0
16093 gshieldx_t4(j,i)=0.0d0
16094 gshieldc_t4(j,i)=0.0d0
16095 gshieldc_loc_t4(j,i)=0.0d0
16096 gshieldx_ll(j,i)=0.0d0
16097 gshieldc_ll(j,i)=0.0d0
16098 gshieldc_loc_ll(j,i)=0.0d0
16100 gg_tube_sc(j,i)=0.0d0
16103 gloc_sc(intertyp,i,icg)=0.0d0
16112 grad_shield_side(k,j,i)=0.0d0
16113 grad_shield_loc(k,j,i)=0.0d0
16120 ! Initialize the gradient of local energy terms.
16122 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16123 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16124 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16125 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16126 ! allocate(gel_loc_turn3(nres))
16127 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16128 ! allocate(gsccor_loc(nres)) !(maxres)
16134 gel_loc_loc(i)=0.0d0
16136 g_corr5_loc(i)=0.0d0
16137 g_corr6_loc(i)=0.0d0
16138 gel_loc_turn3(i)=0.0d0
16139 gel_loc_turn4(i)=0.0d0
16140 gel_loc_turn6(i)=0.0d0
16141 gsccor_loc(i)=0.0d0
16143 ! initialize gcart and gxcart
16144 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16152 end subroutine zerograd
16153 !-----------------------------------------------------------------------------
16154 real(kind=8) function fdum()
16158 !-----------------------------------------------------------------------------
16160 !-----------------------------------------------------------------------------
16161 subroutine intcartderiv
16162 ! implicit real*8 (a-h,o-z)
16163 ! include 'DIMENSIONS'
16167 ! include 'COMMON.SETUP'
16168 ! include 'COMMON.CHAIN'
16169 ! include 'COMMON.VAR'
16170 ! include 'COMMON.GEO'
16171 ! include 'COMMON.INTERACT'
16172 ! include 'COMMON.DERIV'
16173 ! include 'COMMON.IOUNITS'
16174 ! include 'COMMON.LOCAL'
16175 ! include 'COMMON.SCCOR'
16176 real(kind=8) :: pi4,pi34
16177 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16178 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16179 dcosomega,dsinomega !(3,3,maxres)
16180 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16183 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16184 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16185 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16186 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16190 !el from module energy-------------
16191 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16192 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16193 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16195 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16196 !el allocate(dsintau(3,3,3,0:nres2))
16197 !el allocate(dtauangle(3,3,3,0:nres2))
16198 !el allocate(domicron(3,2,2,0:nres2))
16199 !el allocate(dcosomicron(3,2,2,0:nres2))
16203 #if defined(MPI) && defined(PARINTDER)
16204 if (nfgtasks.gt.1 .and. me.eq.king) &
16205 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16210 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16211 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16213 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16216 dtheta(j,1,i)=0.0d0
16217 dtheta(j,2,i)=0.0d0
16223 ! Derivatives of theta's
16224 #if defined(MPI) && defined(PARINTDER)
16225 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16226 do i=max0(ithet_start-1,3),ithet_end
16230 cost=dcos(theta(i))
16231 sint=sqrt(1-cost*cost)
16233 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16235 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16236 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16238 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16241 #if defined(MPI) && defined(PARINTDER)
16242 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16243 do i=max0(ithet_start-1,3),ithet_end
16247 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16248 cost1=dcos(omicron(1,i))
16249 sint1=sqrt(1-cost1*cost1)
16250 cost2=dcos(omicron(2,i))
16251 sint2=sqrt(1-cost2*cost2)
16253 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16254 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16255 cost1*dc_norm(j,i-2))/ &
16257 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16258 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16259 +cost1*(dc_norm(j,i-1+nres)))/ &
16261 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16262 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16263 !C Looks messy but better than if in loop
16264 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16265 +cost2*dc_norm(j,i-1))/ &
16267 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16268 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16269 +cost2*(-dc_norm(j,i-1+nres)))/ &
16271 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16272 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16276 !elwrite(iout,*) "after vbld write"
16277 ! Derivatives of phi:
16278 ! If phi is 0 or 180 degrees, then the formulas
16279 ! have to be derived by power series expansion of the
16280 ! conventional formulas around 0 and 180.
16282 do i=iphi1_start,iphi1_end
16286 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16287 ! the conventional case
16288 sint=dsin(theta(i))
16289 sint1=dsin(theta(i-1))
16291 cost=dcos(theta(i))
16292 cost1=dcos(theta(i-1))
16294 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16295 fac0=1.0d0/(sint1*sint)
16298 fac3=cosg*cost1/(sint1*sint1)
16299 fac4=cosg*cost/(sint*sint)
16300 ! Obtaining the gamma derivatives from sine derivative
16301 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16302 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16303 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16304 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16305 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16306 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16310 cosg_inv=1.0d0/cosg
16311 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16312 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16313 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16314 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16316 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16317 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16318 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16319 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16320 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16321 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16322 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16324 ! Bug fixed 3/24/05 (AL)
16326 ! Obtaining the gamma derivatives from cosine derivative
16329 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16330 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16331 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16332 dc_norm(j,i-3))/vbld(i-2)
16333 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16334 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16335 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16337 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16338 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16339 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16340 dc_norm(j,i-1))/vbld(i)
16341 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16346 !alculate derivative of Tauangle
16348 do i=itau_start,itau_end
16351 !elwrite(iout,*) " vecpr",i,nres
16353 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16354 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16355 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16356 !c dtauangle(j,intertyp,dervityp,residue number)
16357 !c INTERTYP=1 SC...Ca...Ca..Ca
16358 ! the conventional case
16359 sint=dsin(theta(i))
16360 sint1=dsin(omicron(2,i-1))
16361 sing=dsin(tauangle(1,i))
16362 cost=dcos(theta(i))
16363 cost1=dcos(omicron(2,i-1))
16364 cosg=dcos(tauangle(1,i))
16365 !elwrite(iout,*) " vecpr5",i,nres
16367 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16368 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16369 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16370 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16372 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16373 fac0=1.0d0/(sint1*sint)
16376 fac3=cosg*cost1/(sint1*sint1)
16377 fac4=cosg*cost/(sint*sint)
16378 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16379 ! Obtaining the gamma derivatives from sine derivative
16380 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16381 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16382 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16383 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16384 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16385 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16389 cosg_inv=1.0d0/cosg
16390 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16391 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16392 *vbld_inv(i-2+nres)
16393 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16394 dsintau(j,1,2,i)= &
16395 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16396 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16397 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16398 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16399 ! Bug fixed 3/24/05 (AL)
16400 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16401 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16402 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16403 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16405 ! Obtaining the gamma derivatives from cosine derivative
16408 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16409 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16410 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16411 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16412 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16413 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16415 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16416 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16417 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16418 dc_norm(j,i-1))/vbld(i)
16419 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16420 ! write (iout,*) "else",i
16424 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16427 !C Second case Ca...Ca...Ca...SC
16429 do i=itau_start,itau_end
16433 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16434 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16435 ! the conventional case
16436 sint=dsin(omicron(1,i))
16437 sint1=dsin(theta(i-1))
16438 sing=dsin(tauangle(2,i))
16439 cost=dcos(omicron(1,i))
16440 cost1=dcos(theta(i-1))
16441 cosg=dcos(tauangle(2,i))
16443 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16445 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16446 fac0=1.0d0/(sint1*sint)
16449 fac3=cosg*cost1/(sint1*sint1)
16450 fac4=cosg*cost/(sint*sint)
16451 ! Obtaining the gamma derivatives from sine derivative
16452 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16453 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16454 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16455 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16456 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16457 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16461 cosg_inv=1.0d0/cosg
16462 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16463 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16464 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16465 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16466 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16467 dsintau(j,2,2,i)= &
16468 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16469 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16470 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16471 ! & sing*ctgt*domicron(j,1,2,i),
16472 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16473 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16474 ! Bug fixed 3/24/05 (AL)
16475 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16476 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16477 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16478 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16480 ! Obtaining the gamma derivatives from cosine derivative
16483 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16484 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16485 dc_norm(j,i-3))/vbld(i-2)
16486 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16487 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16488 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16489 dcosomicron(j,1,1,i)
16490 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16491 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16492 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16493 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16494 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16495 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16500 !CC third case SC...Ca...Ca...SC
16503 do i=itau_start,itau_end
16507 ! the conventional case
16508 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16509 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16510 sint=dsin(omicron(1,i))
16511 sint1=dsin(omicron(2,i-1))
16512 sing=dsin(tauangle(3,i))
16513 cost=dcos(omicron(1,i))
16514 cost1=dcos(omicron(2,i-1))
16515 cosg=dcos(tauangle(3,i))
16517 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16518 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16520 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16521 fac0=1.0d0/(sint1*sint)
16524 fac3=cosg*cost1/(sint1*sint1)
16525 fac4=cosg*cost/(sint*sint)
16526 ! Obtaining the gamma derivatives from sine derivative
16527 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16528 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16529 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16530 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16531 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16532 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16536 cosg_inv=1.0d0/cosg
16537 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16538 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16539 *vbld_inv(i-2+nres)
16540 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16541 dsintau(j,3,2,i)= &
16542 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16543 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16544 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16545 ! Bug fixed 3/24/05 (AL)
16546 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16547 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16548 *vbld_inv(i-1+nres)
16549 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16550 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16552 ! Obtaining the gamma derivatives from cosine derivative
16555 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16556 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16557 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16558 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16559 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16560 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16561 dcosomicron(j,1,1,i)
16562 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16563 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16564 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16565 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16566 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16567 ! write(iout,*) "else",i
16573 ! Derivatives of side-chain angles alpha and omega
16574 #if defined(MPI) && defined(PARINTDER)
16575 do i=ibond_start,ibond_end
16579 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16580 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16583 fac8=fac5/vbld(i+1)
16584 fac9=fac5/vbld(i+nres)
16585 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16586 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16587 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16588 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16589 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16590 sina=sqrt(1-cosa*cosa)
16592 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16594 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16595 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16596 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16597 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16598 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16599 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16600 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16601 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16603 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16605 ! obtaining the derivatives of omega from sines
16606 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16607 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16608 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16609 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16611 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16612 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16613 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16614 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16615 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16616 coso_inv=1.0d0/dcos(omeg(i))
16618 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16619 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16620 (sino*dc_norm(j,i-1))/vbld(i)
16621 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16622 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16623 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16624 -sino*dc_norm(j,i)/vbld(i+1)
16625 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16626 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16627 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16629 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16632 ! obtaining the derivatives of omega from cosines
16633 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16634 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16639 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16640 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16641 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16642 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16643 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16644 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16645 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16646 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16647 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16648 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16649 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16650 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16651 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16652 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16653 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16659 dalpha(k,j,i)=0.0d0
16660 domega(k,j,i)=0.0d0
16666 #if defined(MPI) && defined(PARINTDER)
16667 if (nfgtasks.gt.1) then
16669 !d write (iout,*) "Gather dtheta"
16670 !d call flush(iout)
16671 write (iout,*) "dtheta before gather"
16673 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
16676 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
16677 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
16678 king,FG_COMM,IERROR)
16680 !d write (iout,*) "Gather dphi"
16681 !d call flush(iout)
16682 write (iout,*) "dphi before gather"
16684 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
16687 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
16688 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
16689 king,FG_COMM,IERROR)
16690 !d write (iout,*) "Gather dalpha"
16691 !d call flush(iout)
16693 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
16694 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16695 king,FG_COMM,IERROR)
16696 !d write (iout,*) "Gather domega"
16697 !d call flush(iout)
16698 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
16699 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16700 king,FG_COMM,IERROR)
16705 write (iout,*) "dtheta after gather"
16707 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
16709 write (iout,*) "dphi after gather"
16711 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
16713 write (iout,*) "dalpha after gather"
16715 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
16717 write (iout,*) "domega after gather"
16719 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
16723 end subroutine intcartderiv
16724 !-----------------------------------------------------------------------------
16725 subroutine checkintcartgrad
16726 ! implicit real*8 (a-h,o-z)
16727 ! include 'DIMENSIONS'
16731 ! include 'COMMON.CHAIN'
16732 ! include 'COMMON.VAR'
16733 ! include 'COMMON.GEO'
16734 ! include 'COMMON.INTERACT'
16735 ! include 'COMMON.DERIV'
16736 ! include 'COMMON.IOUNITS'
16737 ! include 'COMMON.SETUP'
16738 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
16739 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
16740 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
16741 real(kind=8),dimension(3) :: dc_norm_s
16742 real(kind=8) :: aincr=1.0d-5
16744 real(kind=8) :: dcji
16747 theta_s(i)=theta(i)
16751 ! Check theta gradient
16753 "Analytical (upper) and numerical (lower) gradient of theta"
16758 dc(j,i-2)=dcji+aincr
16759 call chainbuild_cart
16760 call int_from_cart1(.false.)
16761 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
16764 dc(j,i-1)=dc(j,i-1)+aincr
16765 call chainbuild_cart
16766 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
16769 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
16770 !el (dtheta(j,2,i),j=1,3)
16771 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
16772 !el (dthetanum(j,2,i),j=1,3)
16773 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
16774 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
16775 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
16778 ! Check gamma gradient
16780 "Analytical (upper) and numerical (lower) gradient of gamma"
16784 dc(j,i-3)=dcji+aincr
16785 call chainbuild_cart
16786 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
16789 dc(j,i-2)=dcji+aincr
16790 call chainbuild_cart
16791 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
16794 dc(j,i-1)=dc(j,i-1)+aincr
16795 call chainbuild_cart
16796 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
16799 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
16800 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
16801 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
16802 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
16803 !el write (iout,'(5x,3(3f10.5,5x))') &
16804 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
16805 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
16806 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
16809 ! Check alpha gradient
16811 "Analytical (upper) and numerical (lower) gradient of alpha"
16813 if(itype(i,1).ne.10) then
16816 dc(j,i-1)=dcji+aincr
16817 call chainbuild_cart
16818 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
16823 call chainbuild_cart
16824 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
16828 dc(j,i+nres)=dc(j,i+nres)+aincr
16829 call chainbuild_cart
16830 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
16835 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
16836 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
16837 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
16838 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
16839 !el write (iout,'(5x,3(3f10.5,5x))') &
16840 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
16841 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
16842 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
16845 ! Check omega gradient
16847 "Analytical (upper) and numerical (lower) gradient of omega"
16849 if(itype(i,1).ne.10) then
16852 dc(j,i-1)=dcji+aincr
16853 call chainbuild_cart
16854 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
16859 call chainbuild_cart
16860 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
16864 dc(j,i+nres)=dc(j,i+nres)+aincr
16865 call chainbuild_cart
16866 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
16871 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
16872 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
16873 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
16874 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
16875 !el write (iout,'(5x,3(3f10.5,5x))') &
16876 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
16877 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
16878 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
16882 end subroutine checkintcartgrad
16883 !-----------------------------------------------------------------------------
16885 !-----------------------------------------------------------------------------
16886 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
16887 ! implicit real*8 (a-h,o-z)
16888 ! include 'DIMENSIONS'
16889 ! include 'COMMON.IOUNITS'
16890 ! include 'COMMON.CHAIN'
16891 ! include 'COMMON.INTERACT'
16892 ! include 'COMMON.VAR'
16893 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
16894 integer :: kkk,nsep=3
16895 real(kind=8) :: qm !dist,
16896 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
16897 logical :: lprn=.false.
16899 ! real(kind=8) :: sigm,x
16901 !el sigm(x)=0.25d0*x ! local function
16907 do il=seg1+nsep,seg2
16910 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
16911 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
16912 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16914 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16915 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
16918 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16919 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16920 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16921 dijCM=dist(il+nres,jl+nres)
16922 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16924 qq = qq+qqij+qqijCM
16930 if((seg3-il).lt.3) then
16937 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16938 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16939 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16941 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16942 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
16945 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16946 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16947 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16948 dijCM=dist(il+nres,jl+nres)
16949 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16951 qq = qq+qqij+qqijCM
16956 if (qqmax.le.qq) qqmax=qq
16958 qwolynes=1.0d0-qqmax
16960 end function qwolynes
16961 !-----------------------------------------------------------------------------
16962 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
16963 ! implicit real*8 (a-h,o-z)
16964 ! include 'DIMENSIONS'
16965 ! include 'COMMON.IOUNITS'
16966 ! include 'COMMON.CHAIN'
16967 ! include 'COMMON.INTERACT'
16968 ! include 'COMMON.VAR'
16969 ! include 'COMMON.MD'
16970 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
16971 integer :: nsep=3, kkk
16972 !el real(kind=8) :: dist
16973 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
16974 logical :: lprn=.false.
16976 real(kind=8) :: sim,dd0,fac,ddqij
16977 !el sigm(x)=0.25d0*x ! local function
16987 do il=seg1+nsep,seg2
16990 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16991 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16992 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16994 sim = 1.0d0/sigm(d0ij)
16997 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
16999 ddqij = (c(k,il)-c(k,jl))*fac
17000 dqwol(k,il)=dqwol(k,il)+ddqij
17001 dqwol(k,jl)=dqwol(k,jl)-ddqij
17004 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17007 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17008 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17009 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17010 dijCM=dist(il+nres,jl+nres)
17011 sim = 1.0d0/sigm(d0ijCM)
17014 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17016 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17017 dxqwol(k,il)=dxqwol(k,il)+ddqij
17018 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17025 if((seg3-il).lt.3) then
17032 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17033 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17034 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17036 sim = 1.0d0/sigm(d0ij)
17039 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17041 ddqij = (c(k,il)-c(k,jl))*fac
17042 dqwol(k,il)=dqwol(k,il)+ddqij
17043 dqwol(k,jl)=dqwol(k,jl)-ddqij
17045 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17048 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17049 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17050 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17051 dijCM=dist(il+nres,jl+nres)
17052 sim = 1.0d0/sigm(d0ijCM)
17055 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17057 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17058 dxqwol(k,il)=dxqwol(k,il)+ddqij
17059 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17068 dqwol(j,i)=dqwol(j,i)/nl
17069 dxqwol(j,i)=dxqwol(j,i)/nl
17073 end subroutine qwolynes_prim
17074 !-----------------------------------------------------------------------------
17075 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17076 ! implicit real*8 (a-h,o-z)
17077 ! include 'DIMENSIONS'
17078 ! include 'COMMON.IOUNITS'
17079 ! include 'COMMON.CHAIN'
17080 ! include 'COMMON.INTERACT'
17081 ! include 'COMMON.VAR'
17082 integer :: seg1,seg2,seg3,seg4
17084 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17085 real(kind=8),dimension(3,0:2*nres) :: cdummy
17086 real(kind=8) :: q1,q2
17087 real(kind=8) :: delta=1.0d-10
17092 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17094 c(j,i)=c(j,i)+delta
17095 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17096 qwolan(j,i)=(q2-q1)/delta
17102 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17103 cdummy(j,i+nres)=c(j,i+nres)
17104 c(j,i+nres)=c(j,i+nres)+delta
17105 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17106 qwolxan(j,i)=(q2-q1)/delta
17107 c(j,i+nres)=cdummy(j,i+nres)
17110 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17112 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17114 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17116 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17119 end subroutine qwol_num
17120 !-----------------------------------------------------------------------------
17121 subroutine EconstrQ
17122 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17123 ! implicit real*8 (a-h,o-z)
17124 ! include 'DIMENSIONS'
17125 ! include 'COMMON.CONTROL'
17126 ! include 'COMMON.VAR'
17127 ! include 'COMMON.MD'
17130 ! include 'COMMON.LANGEVIN'
17132 ! include 'COMMON.LANGEVIN.lang0'
17134 ! include 'COMMON.CHAIN'
17135 ! include 'COMMON.DERIV'
17136 ! include 'COMMON.GEO'
17137 ! include 'COMMON.LOCAL'
17138 ! include 'COMMON.INTERACT'
17139 ! include 'COMMON.IOUNITS'
17140 ! include 'COMMON.NAMES'
17141 ! include 'COMMON.TIME1'
17142 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17143 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17145 integer :: kstart,kend,lstart,lend,idummy
17146 real(kind=8) :: delta=1.0d-7
17147 integer :: i,j,k,ii
17151 dudconst(j,i)=0.0d0
17152 duxconst(j,i)=0.0d0
17153 dudxconst(j,i)=0.0d0
17158 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17160 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17161 ! Calculating the derivatives of Constraint energy with respect to Q
17162 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17164 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17165 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17166 ! hmnum=(hm2-hm1)/delta
17167 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17168 ! & qinfrag(i,iset))
17169 ! write(iout,*) "harmonicnum frag", hmnum
17170 ! Calculating the derivatives of Q with respect to cartesian coordinates
17171 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17173 ! write(iout,*) "dqwol "
17175 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17177 ! write(iout,*) "dxqwol "
17179 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17181 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17182 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17183 ! & ,idummy,idummy)
17184 ! The gradients of Uconst in Cs
17187 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17188 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17193 kstart=ifrag(1,ipair(1,i,iset),iset)
17194 kend=ifrag(2,ipair(1,i,iset),iset)
17195 lstart=ifrag(1,ipair(2,i,iset),iset)
17196 lend=ifrag(2,ipair(2,i,iset),iset)
17197 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17198 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17199 ! Calculating dU/dQ
17200 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17201 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17202 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17203 ! hmnum=(hm2-hm1)/delta
17204 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17205 ! & qinpair(i,iset))
17206 ! write(iout,*) "harmonicnum pair ", hmnum
17207 ! Calculating dQ/dXi
17208 call qwolynes_prim(kstart,kend,.false.,&
17210 ! write(iout,*) "dqwol "
17212 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17214 ! write(iout,*) "dxqwol "
17216 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17218 ! Calculating numerical gradients
17219 ! call qwol_num(kstart,kend,.false.
17221 ! The gradients of Uconst in Cs
17224 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17225 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17229 ! write(iout,*) "Uconst inside subroutine ", Uconst
17230 ! Transforming the gradients from Cs to dCs for the backbone
17234 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17238 ! Transforming the gradients from Cs to dCs for the side chains
17241 dudxconst(j,i)=duxconst(j,i)
17244 ! write(iout,*) "dU/ddc backbone "
17246 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17248 ! write(iout,*) "dU/ddX side chain "
17250 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17252 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17253 ! call dEconstrQ_num
17255 end subroutine EconstrQ
17256 !-----------------------------------------------------------------------------
17257 subroutine dEconstrQ_num
17258 ! Calculating numerical dUconst/ddc and dUconst/ddx
17259 ! implicit real*8 (a-h,o-z)
17260 ! include 'DIMENSIONS'
17261 ! include 'COMMON.CONTROL'
17262 ! include 'COMMON.VAR'
17263 ! include 'COMMON.MD'
17266 ! include 'COMMON.LANGEVIN'
17268 ! include 'COMMON.LANGEVIN.lang0'
17270 ! include 'COMMON.CHAIN'
17271 ! include 'COMMON.DERIV'
17272 ! include 'COMMON.GEO'
17273 ! include 'COMMON.LOCAL'
17274 ! include 'COMMON.INTERACT'
17275 ! include 'COMMON.IOUNITS'
17276 ! include 'COMMON.NAMES'
17277 ! include 'COMMON.TIME1'
17278 real(kind=8) :: uzap1,uzap2
17279 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17280 integer :: kstart,kend,lstart,lend,idummy
17281 real(kind=8) :: delta=1.0d-7
17282 !el local variables
17288 dUcartan(j,i)=0.0d0
17289 cdummy(j,i)=dc(j,i)
17290 dc(j,i)=dc(j,i)+delta
17291 call chainbuild_cart
17294 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17296 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17300 kstart=ifrag(1,ipair(1,ii,iset),iset)
17301 kend=ifrag(2,ipair(1,ii,iset),iset)
17302 lstart=ifrag(1,ipair(2,ii,iset),iset)
17303 lend=ifrag(2,ipair(2,ii,iset),iset)
17304 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17305 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17308 dc(j,i)=cdummy(j,i)
17309 call chainbuild_cart
17312 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17314 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17318 kstart=ifrag(1,ipair(1,ii,iset),iset)
17319 kend=ifrag(2,ipair(1,ii,iset),iset)
17320 lstart=ifrag(1,ipair(2,ii,iset),iset)
17321 lend=ifrag(2,ipair(2,ii,iset),iset)
17322 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17323 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17326 ducartan(j,i)=(uzap2-uzap1)/(delta)
17329 ! Calculating numerical gradients for dU/ddx
17331 duxcartan(j,i)=0.0d0
17333 cdummy(j,i)=dc(j,i+nres)
17334 dc(j,i+nres)=dc(j,i+nres)+delta
17335 call chainbuild_cart
17338 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17340 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17344 kstart=ifrag(1,ipair(1,ii,iset),iset)
17345 kend=ifrag(2,ipair(1,ii,iset),iset)
17346 lstart=ifrag(1,ipair(2,ii,iset),iset)
17347 lend=ifrag(2,ipair(2,ii,iset),iset)
17348 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17349 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17352 dc(j,i+nres)=cdummy(j,i)
17353 call chainbuild_cart
17356 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17357 ifrag(2,ii,iset),.true.,idummy,idummy)
17358 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17362 kstart=ifrag(1,ipair(1,ii,iset),iset)
17363 kend=ifrag(2,ipair(1,ii,iset),iset)
17364 lstart=ifrag(1,ipair(2,ii,iset),iset)
17365 lend=ifrag(2,ipair(2,ii,iset),iset)
17366 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17367 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17370 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17373 write(iout,*) "Numerical dUconst/ddc backbone "
17375 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17377 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17379 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17382 end subroutine dEconstrQ_num
17383 !-----------------------------------------------------------------------------
17385 !-----------------------------------------------------------------------------
17386 subroutine check_energies
17388 ! use random, only: ran_number
17392 ! include 'DIMENSIONS'
17393 ! include 'COMMON.CHAIN'
17394 ! include 'COMMON.VAR'
17395 ! include 'COMMON.IOUNITS'
17396 ! include 'COMMON.SBRIDGE'
17397 ! include 'COMMON.LOCAL'
17398 ! include 'COMMON.GEO'
17400 ! External functions
17401 !EL double precision ran_number
17402 !EL external ran_number
17405 integer :: i,j,k,l,lmax,p,pmax
17406 real(kind=8) :: rmin,rmax
17407 real(kind=8) :: eij
17410 real(kind=8) :: wi,rij,tj,pj
17432 !t wi=ran_number(0.0D0,pi)
17433 ! wi=ran_number(0.0D0,pi/6.0D0)
17435 !t tj=ran_number(0.0D0,pi)
17436 !t pj=ran_number(0.0D0,pi)
17437 ! pj=ran_number(0.0D0,pi/6.0D0)
17441 !t rij=ran_number(rmin,rmax)
17443 c(1,j)=d*sin(pj)*cos(tj)
17444 c(2,j)=d*sin(pj)*sin(tj)
17450 c(3,i)=-rij-d*cos(wi)
17453 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17454 dc_norm(k,nres+i)=dc(k,nres+i)/d
17455 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17456 dc_norm(k,nres+j)=dc(k,nres+j)/d
17459 call dyn_ssbond_ene(i,j,eij)
17464 end subroutine check_energies
17465 !-----------------------------------------------------------------------------
17466 subroutine dyn_ssbond_ene(resi,resj,eij)
17471 ! include 'DIMENSIONS'
17472 ! include 'COMMON.SBRIDGE'
17473 ! include 'COMMON.CHAIN'
17474 ! include 'COMMON.DERIV'
17475 ! include 'COMMON.LOCAL'
17476 ! include 'COMMON.INTERACT'
17477 ! include 'COMMON.VAR'
17478 ! include 'COMMON.IOUNITS'
17479 ! include 'COMMON.CALC'
17483 ! include 'COMMON.MD'
17484 ! use MD, only: totT,t_bath
17487 ! External functions
17488 !EL double precision h_base
17489 !EL external h_base
17492 integer :: resi,resj
17495 real(kind=8) :: eij
17498 logical :: havebond
17499 integer itypi,itypj
17500 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17501 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17502 real(kind=8),dimension(3) :: dcosom1,dcosom2
17504 real(kind=8) :: pom1,pom2
17505 real(kind=8) :: ljA,ljB,ljXs
17506 real(kind=8),dimension(1:3) :: d_ljB
17507 real(kind=8) :: ssA,ssB,ssC,ssXs
17508 real(kind=8) :: ssxm,ljxm,ssm,ljm
17509 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17510 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17511 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17512 !-------FIRST METHOD
17514 real(kind=8),dimension(1:3) :: d_xm
17515 !-------END FIRST METHOD
17516 !-------SECOND METHOD
17517 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17518 !-------END SECOND METHOD
17520 !-------TESTING CODE
17521 !el logical :: checkstop,transgrad
17522 !el common /sschecks/ checkstop,transgrad
17524 integer :: icheck,nicheck,jcheck,njcheck
17525 real(kind=8),dimension(-1:1) :: echeck
17526 real(kind=8) :: deps,ssx0,ljx0
17527 !-------END TESTING CODE
17533 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17534 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17537 dxi=dc_norm(1,nres+i)
17538 dyi=dc_norm(2,nres+i)
17539 dzi=dc_norm(3,nres+i)
17540 dsci_inv=vbld_inv(i+nres)
17543 xj=c(1,nres+j)-c(1,nres+i)
17544 yj=c(2,nres+j)-c(2,nres+i)
17545 zj=c(3,nres+j)-c(3,nres+i)
17546 dxj=dc_norm(1,nres+j)
17547 dyj=dc_norm(2,nres+j)
17548 dzj=dc_norm(3,nres+j)
17549 dscj_inv=vbld_inv(j+nres)
17551 chi1=chi(itypi,itypj)
17552 chi2=chi(itypj,itypi)
17559 alf12=0.5D0*(alf1+alf2)
17561 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17562 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17563 ! The following are set in sc_angular
17567 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17568 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17569 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17571 rij=1.0D0/rij ! Reset this so it makes sense
17573 sig0ij=sigma(itypi,itypj)
17574 sig=sig0ij*dsqrt(1.0D0/sigsq)
17577 ljA=eps1*eps2rt**2*eps3rt**2
17578 ljB=ljA*bb_aq(itypi,itypj)
17579 ljA=ljA*aa_aq(itypi,itypj)
17580 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17585 deltat12=om2-om1+2.0d0
17586 cosphi=om12-om1*om2
17590 +akth*(deltat1*deltat1+deltat2*deltat2) &
17591 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17592 ssxm=ssXs-0.5D0*ssB/ssA
17594 !-------TESTING CODE
17595 !$$$c Some extra output
17596 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17597 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17598 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17599 !$$$ if (ssx0.gt.0.0d0) then
17600 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17604 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17605 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17606 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17608 !-------END TESTING CODE
17610 !-------TESTING CODE
17611 ! Stop and plot energy and derivative as a function of distance
17612 if (checkstop) then
17613 ssm=ssC-0.25D0*ssB*ssB/ssA
17614 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17615 if (ssm.lt.ljm .and. &
17616 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17624 if (.not.checkstop) then
17629 do icheck=0,nicheck
17630 do jcheck=-1,njcheck
17631 if (checkstop) rij=(ssxm-1.0d0)+ &
17632 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17633 !-------END TESTING CODE
17635 if (rij.gt.ljxm) then
17638 fac=(1.0D0/ljd)**expon
17639 e1=fac*fac*aa_aq(itypi,itypj)
17640 e2=fac*bb_aq(itypi,itypj)
17641 eij=eps1*eps2rt*eps3rt*(e1+e2)
17644 eij=eij*eps2rt*eps3rt
17647 e1=e1*eps1*eps2rt**2*eps3rt**2
17648 ed=-expon*(e1+eij)/ljd
17650 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17651 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17652 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17653 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17654 else if (rij.lt.ssxm) then
17657 eij=ssA*ssd*ssd+ssB*ssd+ssC
17659 ed=2*akcm*ssd+akct*deltat12
17661 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17662 eom1=-2*akth*deltat1-pom1-om2*pom2
17663 eom2= 2*akth*deltat2+pom1-om1*pom2
17666 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17668 d_ssxm(1)=0.5D0*akct/ssA
17669 d_ssxm(2)=-d_ssxm(1)
17672 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
17673 d_ljxm(2)=d_ljxm(1)*sigsq_om2
17674 d_ljxm(3)=d_ljxm(1)*sigsq_om12
17675 d_ljxm(1)=d_ljxm(1)*sigsq_om1
17677 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17678 xm=0.5d0*(ssxm+ljxm)
17680 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
17682 if (rij.lt.xm) then
17684 ssm=ssC-0.25D0*ssB*ssB/ssA
17685 d_ssm(1)=0.5D0*akct*ssB/ssA
17686 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17687 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17689 f1=(rij-xm)/(ssxm-xm)
17690 f2=(rij-ssxm)/(xm-ssxm)
17694 delta_inv=1.0d0/(xm-ssxm)
17695 deltasq_inv=delta_inv*delta_inv
17697 fac1=deltasq_inv*fac*(xm-rij)
17698 fac2=deltasq_inv*fac*(rij-ssxm)
17699 ed=delta_inv*(Ht*hd2-ssm*hd1)
17700 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
17701 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
17702 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
17705 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17706 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
17707 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
17708 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
17710 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
17711 f1=(rij-ljxm)/(xm-ljxm)
17712 f2=(rij-xm)/(ljxm-xm)
17716 delta_inv=1.0d0/(ljxm-xm)
17717 deltasq_inv=delta_inv*delta_inv
17719 fac1=deltasq_inv*fac*(ljxm-rij)
17720 fac2=deltasq_inv*fac*(rij-xm)
17721 ed=delta_inv*(ljm*hd2-Ht*hd1)
17722 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
17723 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
17724 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
17726 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17728 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17734 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
17735 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
17736 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
17738 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17739 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
17740 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17741 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17742 !$$$ d_ssm(3)=omega
17744 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
17746 !$$$ d_ljm(k)=ljm*d_ljB(k)
17750 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
17751 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
17752 !$$$ d_ss(2)=akct*ssd
17753 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
17754 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
17757 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
17758 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
17759 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
17761 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
17762 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
17764 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
17766 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
17767 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
17768 !$$$ h1=h_base(f1,hd1)
17769 !$$$ h2=h_base(f2,hd2)
17770 !$$$ eij=ss*h1+ljf*h2
17771 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
17772 !$$$ deltasq_inv=delta_inv*delta_inv
17773 !$$$ fac=ljf*hd2-ss*hd1
17774 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
17775 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
17776 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
17777 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
17778 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
17779 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
17780 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
17782 !$$$ havebond=.false.
17783 !$$$ if (ed.gt.0.0d0) havebond=.true.
17784 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17791 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
17792 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17793 ! & "SSBOND_E_FORM",totT,t_bath,i,j
17797 dyn_ssbond_ij(i,j)=eij
17798 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
17799 dyn_ssbond_ij(i,j)=1.0d300
17802 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17803 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
17808 !-------TESTING CODE
17809 !el if (checkstop) then
17810 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
17811 "CHECKSTOP",rij,eij,ed
17815 if (checkstop) then
17816 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
17819 if (checkstop) then
17823 !-------END TESTING CODE
17826 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
17827 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
17830 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
17833 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
17834 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
17835 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
17836 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
17837 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
17838 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
17842 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
17847 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17848 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17852 end subroutine dyn_ssbond_ene
17853 !--------------------------------------------------------------------------
17854 subroutine triple_ssbond_ene(resi,resj,resk,eij)
17859 ! include 'DIMENSIONS'
17860 ! include 'COMMON.SBRIDGE'
17861 ! include 'COMMON.CHAIN'
17862 ! include 'COMMON.DERIV'
17863 ! include 'COMMON.LOCAL'
17864 ! include 'COMMON.INTERACT'
17865 ! include 'COMMON.VAR'
17866 ! include 'COMMON.IOUNITS'
17867 ! include 'COMMON.CALC'
17871 ! include 'COMMON.MD'
17872 ! use MD, only: totT,t_bath
17875 double precision h_base
17879 integer resi,resj,resk,m,itypi,itypj,itypk
17881 !c Output arguments
17882 double precision eij,eij1,eij2,eij3
17886 !c integer itypi,itypj,k,l
17887 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
17888 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
17889 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
17890 double precision sig0ij,ljd,sig,fac,e1,e2
17891 double precision dcosom1(3),dcosom2(3),ed
17892 double precision pom1,pom2
17893 double precision ljA,ljB,ljXs
17894 double precision d_ljB(1:3)
17895 double precision ssA,ssB,ssC,ssXs
17896 double precision ssxm,ljxm,ssm,ljm
17897 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
17899 if (dtriss.eq.0) return
17903 !C write(iout,*) resi,resj,resk
17905 dxi=dc_norm(1,nres+i)
17906 dyi=dc_norm(2,nres+i)
17907 dzi=dc_norm(3,nres+i)
17908 dsci_inv=vbld_inv(i+nres)
17917 dxj=dc_norm(1,nres+j)
17918 dyj=dc_norm(2,nres+j)
17919 dzj=dc_norm(3,nres+j)
17920 dscj_inv=vbld_inv(j+nres)
17926 dxk=dc_norm(1,nres+k)
17927 dyk=dc_norm(2,nres+k)
17928 dzk=dc_norm(3,nres+k)
17929 dscj_inv=vbld_inv(k+nres)
17939 rrij=(xij*xij+yij*yij+zij*zij)
17940 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17941 rrik=(xik*xik+yik*yik+zik*zik)
17943 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
17945 !C there are three combination of distances for each trisulfide bonds
17946 !C The first case the ith atom is the center
17947 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
17948 !C distance y is second distance the a,b,c,d are parameters derived for
17949 !C this problem d parameter was set as a penalty currenlty set to 1.
17950 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
17953 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
17955 !C second case jth atom is center
17956 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
17959 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
17961 !C the third case kth atom is the center
17962 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
17965 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
17971 !C write(iout,*)i,j,k,eij
17972 !C The energy penalty calculated now time for the gradient part
17973 !C derivative over rij
17974 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
17975 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
17980 gvdwx(m,i)=gvdwx(m,i)-gg(m)
17981 gvdwx(m,j)=gvdwx(m,j)+gg(m)
17985 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17986 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17988 !C now derivative over rik
17989 fac=-eij1**2/dtriss* &
17990 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
17991 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
17996 gvdwx(m,i)=gvdwx(m,i)-gg(m)
17997 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18000 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18001 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18003 !C now derivative over rjk
18004 fac=-eij2**2/dtriss* &
18005 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18006 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18011 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18012 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18015 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18016 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18019 end subroutine triple_ssbond_ene
18023 !-----------------------------------------------------------------------------
18024 real(kind=8) function h_base(x,deriv)
18025 ! A smooth function going 0->1 in range [0,1]
18026 ! It should NOT be called outside range [0,1], it will not work there.
18033 real(kind=8) :: deriv
18036 real(kind=8) :: xsq
18039 ! Two parabolas put together. First derivative zero at extrema
18040 !$$$ if (x.lt.0.5D0) then
18041 !$$$ h_base=2.0D0*x*x
18045 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18046 !$$$ deriv=4.0D0*deriv
18049 ! Third degree polynomial. First derivative zero at extrema
18050 h_base=x*x*(3.0d0-2.0d0*x)
18051 deriv=6.0d0*x*(1.0d0-x)
18053 ! Fifth degree polynomial. First and second derivatives zero at extrema
18055 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18057 !$$$ deriv=deriv*deriv
18058 !$$$ deriv=30.0d0*xsq*deriv
18061 end function h_base
18062 !-----------------------------------------------------------------------------
18063 subroutine dyn_set_nss
18064 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18066 use MD_data, only: totT,t_bath
18068 ! include 'DIMENSIONS'
18072 ! include 'COMMON.SBRIDGE'
18073 ! include 'COMMON.CHAIN'
18074 ! include 'COMMON.IOUNITS'
18075 ! include 'COMMON.SETUP'
18076 ! include 'COMMON.MD'
18078 real(kind=8) :: emin
18079 integer :: i,j,imin,ierr
18080 integer :: diff,allnss,newnss
18081 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18084 integer,dimension(0:nfgtasks) :: i_newnss
18085 integer,dimension(0:nfgtasks) :: displ
18086 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18087 integer :: g_newnss
18092 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18101 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18105 if (allflag(i).eq.0 .and. &
18106 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18107 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18111 if (emin.lt.1.0d300) then
18114 if (allflag(i).eq.0 .and. &
18115 (allihpb(i).eq.allihpb(imin) .or. &
18116 alljhpb(i).eq.allihpb(imin) .or. &
18117 allihpb(i).eq.alljhpb(imin) .or. &
18118 alljhpb(i).eq.alljhpb(imin))) then
18125 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18129 if (allflag(i).eq.1) then
18131 newihpb(newnss)=allihpb(i)
18132 newjhpb(newnss)=alljhpb(i)
18137 if (nfgtasks.gt.1)then
18139 call MPI_Reduce(newnss,g_newnss,1,&
18140 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18141 call MPI_Gather(newnss,1,MPI_INTEGER,&
18142 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18144 do i=1,nfgtasks-1,1
18145 displ(i)=i_newnss(i-1)+displ(i-1)
18147 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18148 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18150 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18151 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18153 if(fg_rank.eq.0) then
18154 ! print *,'g_newnss',g_newnss
18155 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18156 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18159 newihpb(i)=g_newihpb(i)
18160 newjhpb(i)=g_newjhpb(i)
18168 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18169 ! print *,newnss,nss,maxdim
18175 if (idssb(i).eq.newihpb(j) .and. &
18176 jdssb(i).eq.newjhpb(j)) found=.true.
18180 ! write(iout,*) "found",found,i,j
18181 if (.not.found.and.fg_rank.eq.0) &
18182 write(iout,'(a15,f12.2,f8.1,2i5)') &
18183 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18192 if (newihpb(i).eq.idssb(j) .and. &
18193 newjhpb(i).eq.jdssb(j)) found=.true.
18197 ! write(iout,*) "found",found,i,j
18198 if (.not.found.and.fg_rank.eq.0) &
18199 write(iout,'(a15,f12.2,f8.1,2i5)') &
18200 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18207 idssb(i)=newihpb(i)
18208 jdssb(i)=newjhpb(i)
18212 end subroutine dyn_set_nss
18213 ! Lipid transfer energy function
18214 subroutine Eliptransfer(eliptran)
18215 !C this is done by Adasko
18216 !C print *,"wchodze"
18217 !C structure of box:
18219 !C--bordliptop-- buffore starts
18220 !C--bufliptop--- here true lipid starts
18222 !C--buflipbot--- lipid ends buffore starts
18223 !C--bordlipbot--buffore ends
18224 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18227 ! print *, "I am in eliptran"
18228 do i=ilip_start,ilip_end
18230 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18233 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18234 if (positi.le.0.0) positi=positi+boxzsize
18236 !C first for peptide groups
18237 !c for each residue check if it is in lipid or lipid water border area
18238 if ((positi.gt.bordlipbot) &
18239 .and.(positi.lt.bordliptop)) then
18240 !C the energy transfer exist
18241 if (positi.lt.buflipbot) then
18242 !C what fraction I am in
18244 ((positi-bordlipbot)/lipbufthick)
18245 !C lipbufthick is thickenes of lipid buffore
18246 sslip=sscalelip(fracinbuf)
18247 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18248 eliptran=eliptran+sslip*pepliptran
18249 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18250 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18251 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18253 !C print *,"doing sccale for lower part"
18254 !C print *,i,sslip,fracinbuf,ssgradlip
18255 elseif (positi.gt.bufliptop) then
18256 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18257 sslip=sscalelip(fracinbuf)
18258 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18259 eliptran=eliptran+sslip*pepliptran
18260 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18261 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18262 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18263 !C print *, "doing sscalefor top part"
18264 !C print *,i,sslip,fracinbuf,ssgradlip
18266 eliptran=eliptran+pepliptran
18267 !C print *,"I am in true lipid"
18270 !C eliptran=elpitran+0.0 ! I am in water
18272 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18274 ! here starts the side chain transfer
18275 do i=ilip_start,ilip_end
18276 if (itype(i,1).eq.ntyp1) cycle
18277 positi=(mod(c(3,i+nres),boxzsize))
18278 if (positi.le.0) positi=positi+boxzsize
18279 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18280 !c for each residue check if it is in lipid or lipid water border area
18281 !C respos=mod(c(3,i+nres),boxzsize)
18282 !C print *,positi,bordlipbot,buflipbot
18283 if ((positi.gt.bordlipbot) &
18284 .and.(positi.lt.bordliptop)) then
18285 !C the energy transfer exist
18286 if (positi.lt.buflipbot) then
18288 ((positi-bordlipbot)/lipbufthick)
18289 !C lipbufthick is thickenes of lipid buffore
18290 sslip=sscalelip(fracinbuf)
18291 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18292 eliptran=eliptran+sslip*liptranene(itype(i,1))
18293 gliptranx(3,i)=gliptranx(3,i) &
18294 +ssgradlip*liptranene(itype(i,1))
18295 gliptranc(3,i-1)= gliptranc(3,i-1) &
18296 +ssgradlip*liptranene(itype(i,1))
18297 !C print *,"doing sccale for lower part"
18298 elseif (positi.gt.bufliptop) then
18300 ((bordliptop-positi)/lipbufthick)
18301 sslip=sscalelip(fracinbuf)
18302 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18303 eliptran=eliptran+sslip*liptranene(itype(i,1))
18304 gliptranx(3,i)=gliptranx(3,i) &
18305 +ssgradlip*liptranene(itype(i,1))
18306 gliptranc(3,i-1)= gliptranc(3,i-1) &
18307 +ssgradlip*liptranene(itype(i,1))
18308 !C print *, "doing sscalefor top part",sslip,fracinbuf
18310 eliptran=eliptran+liptranene(itype(i,1))
18311 !C print *,"I am in true lipid"
18313 endif ! if in lipid or buffor
18315 !C eliptran=elpitran+0.0 ! I am in water
18316 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18319 end subroutine Eliptransfer
18320 !----------------------------------NANO FUNCTIONS
18321 !C-----------------------------------------------------------------------
18322 !C-----------------------------------------------------------
18323 !C This subroutine is to mimic the histone like structure but as well can be
18324 !C utilizet to nanostructures (infinit) small modification has to be used to
18325 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18326 !C gradient has to be modified at the ends
18327 !C The energy function is Kihara potential
18328 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18329 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18330 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18331 !C simple Kihara potential
18332 subroutine calctube(Etube)
18333 real(kind=8) :: vectube(3),enetube(nres*2)
18334 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18335 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18336 sc_aa_tube,sc_bb_tube
18339 do i=itube_start,itube_end
18341 enetube(i+nres)=0.0d0
18343 !C first we calculate the distance from tube center
18345 do i=itube_start,itube_end
18346 !C lets ommit dummy atoms for now
18347 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18348 !C now calculate distance from center of tube and direction vectors
18351 ! Find minimum distance in periodic box
18353 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18354 vectube(1)=vectube(1)+boxxsize*j
18355 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18356 vectube(2)=vectube(2)+boxysize*j
18357 xminact=abs(vectube(1)-tubecenter(1))
18358 yminact=abs(vectube(2)-tubecenter(2))
18359 if (xmin.gt.xminact) then
18363 if (ymin.gt.yminact) then
18370 vectube(1)=vectube(1)-tubecenter(1)
18371 vectube(2)=vectube(2)-tubecenter(2)
18373 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18374 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18376 !C as the tube is infinity we do not calculate the Z-vector use of Z
18379 !C now calculte the distance
18380 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18381 !C now normalize vector
18382 vectube(1)=vectube(1)/tub_r
18383 vectube(2)=vectube(2)/tub_r
18384 !C calculte rdiffrence between r and r0
18387 rdiff6=rdiff**6.0d0
18388 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18389 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18390 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18391 !C print *,rdiff,rdiff6,pep_aa_tube
18392 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18393 !C now we calculate gradient
18394 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18395 6.0d0*pep_bb_tube)/rdiff6/rdiff
18396 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18398 !C now direction of gg_tube vector
18400 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18401 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18404 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18405 !C print *,gg_tube(1,0),"TU"
18408 do i=itube_start,itube_end
18409 !C Lets not jump over memory as we use many times iti
18411 !C lets ommit dummy atoms for now
18412 if ((iti.eq.ntyp1) &
18413 !C in UNRES uncomment the line below as GLY has no side-chain...
18419 vectube(1)=mod((c(1,i+nres)),boxxsize)
18420 vectube(1)=vectube(1)+boxxsize*j
18421 vectube(2)=mod((c(2,i+nres)),boxysize)
18422 vectube(2)=vectube(2)+boxysize*j
18424 xminact=abs(vectube(1)-tubecenter(1))
18425 yminact=abs(vectube(2)-tubecenter(2))
18426 if (xmin.gt.xminact) then
18430 if (ymin.gt.yminact) then
18437 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18439 vectube(1)=vectube(1)-tubecenter(1)
18440 vectube(2)=vectube(2)-tubecenter(2)
18442 !C as the tube is infinity we do not calculate the Z-vector use of Z
18445 !C now calculte the distance
18446 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18447 !C now normalize vector
18448 vectube(1)=vectube(1)/tub_r
18449 vectube(2)=vectube(2)/tub_r
18451 !C calculte rdiffrence between r and r0
18454 rdiff6=rdiff**6.0d0
18455 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18456 sc_aa_tube=sc_aa_tube_par(iti)
18457 sc_bb_tube=sc_bb_tube_par(iti)
18458 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18459 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18460 6.0d0*sc_bb_tube/rdiff6/rdiff
18461 !C now direction of gg_tube vector
18463 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18464 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18467 do i=itube_start,itube_end
18468 Etube=Etube+enetube(i)+enetube(i+nres)
18470 !C print *,"ETUBE", etube
18472 end subroutine calctube
18473 !C TO DO 1) add to total energy
18474 !C 2) add to gradient summation
18475 !C 3) add reading parameters (AND of course oppening of PARAM file)
18476 !C 4) add reading the center of tube
18478 !C 6) add to zerograd
18479 !C 7) allocate matrices
18482 !C-----------------------------------------------------------------------
18483 !C-----------------------------------------------------------
18484 !C This subroutine is to mimic the histone like structure but as well can be
18485 !C utilizet to nanostructures (infinit) small modification has to be used to
18486 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18487 !C gradient has to be modified at the ends
18488 !C The energy function is Kihara potential
18489 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18490 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18491 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18492 !C simple Kihara potential
18493 subroutine calctube2(Etube)
18494 real(kind=8) :: vectube(3),enetube(nres*2)
18495 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18496 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18497 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18500 do i=itube_start,itube_end
18502 enetube(i+nres)=0.0d0
18504 !C first we calculate the distance from tube center
18505 !C first sugare-phosphate group for NARES this would be peptide group
18507 do i=itube_start,itube_end
18508 !C lets ommit dummy atoms for now
18510 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18511 !C now calculate distance from center of tube and direction vectors
18512 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18513 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18514 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18515 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18519 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18520 vectube(1)=vectube(1)+boxxsize*j
18521 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18522 vectube(2)=vectube(2)+boxysize*j
18524 xminact=abs(vectube(1)-tubecenter(1))
18525 yminact=abs(vectube(2)-tubecenter(2))
18526 if (xmin.gt.xminact) then
18530 if (ymin.gt.yminact) then
18537 vectube(1)=vectube(1)-tubecenter(1)
18538 vectube(2)=vectube(2)-tubecenter(2)
18540 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18541 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18543 !C as the tube is infinity we do not calculate the Z-vector use of Z
18546 !C now calculte the distance
18547 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18548 !C now normalize vector
18549 vectube(1)=vectube(1)/tub_r
18550 vectube(2)=vectube(2)/tub_r
18551 !C calculte rdiffrence between r and r0
18554 rdiff6=rdiff**6.0d0
18555 !C THIS FRAGMENT MAKES TUBE FINITE
18556 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18557 if (positi.le.0) positi=positi+boxzsize
18558 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18559 !c for each residue check if it is in lipid or lipid water border area
18560 !C respos=mod(c(3,i+nres),boxzsize)
18561 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18562 if ((positi.gt.bordtubebot) &
18563 .and.(positi.lt.bordtubetop)) then
18564 !C the energy transfer exist
18565 if (positi.lt.buftubebot) then
18567 ((positi-bordtubebot)/tubebufthick)
18568 !C lipbufthick is thickenes of lipid buffore
18569 sstube=sscalelip(fracinbuf)
18570 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18571 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18572 enetube(i)=enetube(i)+sstube*tubetranenepep
18573 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18574 !C &+ssgradtube*tubetranene(itype(i,1))
18575 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18576 !C &+ssgradtube*tubetranene(itype(i,1))
18577 !C print *,"doing sccale for lower part"
18578 elseif (positi.gt.buftubetop) then
18580 ((bordtubetop-positi)/tubebufthick)
18581 sstube=sscalelip(fracinbuf)
18582 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18583 enetube(i)=enetube(i)+sstube*tubetranenepep
18584 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18585 !C &+ssgradtube*tubetranene(itype(i,1))
18586 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18587 !C &+ssgradtube*tubetranene(itype(i,1))
18588 !C print *, "doing sscalefor top part",sslip,fracinbuf
18592 enetube(i)=enetube(i)+sstube*tubetranenepep
18593 !C print *,"I am in true lipid"
18597 !C ssgradtube=0.0d0
18599 endif ! if in lipid or buffor
18601 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18602 enetube(i)=enetube(i)+sstube* &
18603 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18604 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18605 !C print *,rdiff,rdiff6,pep_aa_tube
18606 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18607 !C now we calculate gradient
18608 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18609 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18610 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18613 !C now direction of gg_tube vector
18615 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18616 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18618 gg_tube(3,i)=gg_tube(3,i) &
18619 +ssgradtube*enetube(i)/sstube/2.0d0
18620 gg_tube(3,i-1)= gg_tube(3,i-1) &
18621 +ssgradtube*enetube(i)/sstube/2.0d0
18624 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18625 !C print *,gg_tube(1,0),"TU"
18626 do i=itube_start,itube_end
18627 !C Lets not jump over memory as we use many times iti
18629 !C lets ommit dummy atoms for now
18630 if ((iti.eq.ntyp1) &
18631 !!C in UNRES uncomment the line below as GLY has no side-chain...
18634 vectube(1)=c(1,i+nres)
18635 vectube(1)=mod(vectube(1),boxxsize)
18636 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18637 vectube(2)=c(2,i+nres)
18638 vectube(2)=mod(vectube(2),boxysize)
18639 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18641 vectube(1)=vectube(1)-tubecenter(1)
18642 vectube(2)=vectube(2)-tubecenter(2)
18643 !C THIS FRAGMENT MAKES TUBE FINITE
18644 positi=(mod(c(3,i+nres),boxzsize))
18645 if (positi.le.0) positi=positi+boxzsize
18646 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18647 !c for each residue check if it is in lipid or lipid water border area
18648 !C respos=mod(c(3,i+nres),boxzsize)
18649 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18651 if ((positi.gt.bordtubebot) &
18652 .and.(positi.lt.bordtubetop)) then
18653 !C the energy transfer exist
18654 if (positi.lt.buftubebot) then
18656 ((positi-bordtubebot)/tubebufthick)
18657 !C lipbufthick is thickenes of lipid buffore
18658 sstube=sscalelip(fracinbuf)
18659 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18660 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18661 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18662 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18663 !C &+ssgradtube*tubetranene(itype(i,1))
18664 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18665 !C &+ssgradtube*tubetranene(itype(i,1))
18666 !C print *,"doing sccale for lower part"
18667 elseif (positi.gt.buftubetop) then
18669 ((bordtubetop-positi)/tubebufthick)
18671 sstube=sscalelip(fracinbuf)
18672 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18673 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18674 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18675 !C &+ssgradtube*tubetranene(itype(i,1))
18676 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18677 !C &+ssgradtube*tubetranene(itype(i,1))
18678 !C print *, "doing sscalefor top part",sslip,fracinbuf
18682 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18683 !C print *,"I am in true lipid"
18687 !C ssgradtube=0.0d0
18689 endif ! if in lipid or buffor
18690 !CEND OF FINITE FRAGMENT
18691 !C as the tube is infinity we do not calculate the Z-vector use of Z
18694 !C now calculte the distance
18695 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18696 !C now normalize vector
18697 vectube(1)=vectube(1)/tub_r
18698 vectube(2)=vectube(2)/tub_r
18699 !C calculte rdiffrence between r and r0
18702 rdiff6=rdiff**6.0d0
18703 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18704 sc_aa_tube=sc_aa_tube_par(iti)
18705 sc_bb_tube=sc_bb_tube_par(iti)
18706 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
18707 *sstube+enetube(i+nres)
18708 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18709 !C now we calculate gradient
18710 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
18711 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
18712 !C now direction of gg_tube vector
18714 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18715 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18717 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
18718 +ssgradtube*enetube(i+nres)/sstube
18719 gg_tube(3,i-1)= gg_tube(3,i-1) &
18720 +ssgradtube*enetube(i+nres)/sstube
18723 do i=itube_start,itube_end
18724 Etube=Etube+enetube(i)+enetube(i+nres)
18726 !C print *,"ETUBE", etube
18728 end subroutine calctube2
18729 !=====================================================================================================================================
18730 subroutine calcnano(Etube)
18731 real(kind=8) :: vectube(3),enetube(nres*2), &
18733 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18734 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
18735 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
18739 ! print *,itube_start,itube_end,"poczatek"
18740 do i=itube_start,itube_end
18742 enetube(i+nres)=0.0d0
18744 !C first we calculate the distance from tube center
18745 !C first sugare-phosphate group for NARES this would be peptide group
18747 do i=itube_start,itube_end
18748 !C lets ommit dummy atoms for now
18749 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18750 !C now calculate distance from center of tube and direction vectors
18756 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18757 vectube(1)=vectube(1)+boxxsize*j
18758 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18759 vectube(2)=vectube(2)+boxysize*j
18760 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18761 vectube(3)=vectube(3)+boxzsize*j
18764 xminact=dabs(vectube(1)-tubecenter(1))
18765 yminact=dabs(vectube(2)-tubecenter(2))
18766 zminact=dabs(vectube(3)-tubecenter(3))
18768 if (xmin.gt.xminact) then
18772 if (ymin.gt.yminact) then
18776 if (zmin.gt.zminact) then
18785 vectube(1)=vectube(1)-tubecenter(1)
18786 vectube(2)=vectube(2)-tubecenter(2)
18787 vectube(3)=vectube(3)-tubecenter(3)
18789 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18790 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18791 !C as the tube is infinity we do not calculate the Z-vector use of Z
18793 !C vectube(3)=0.0d0
18794 !C now calculte the distance
18795 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18796 !C now normalize vector
18797 vectube(1)=vectube(1)/tub_r
18798 vectube(2)=vectube(2)/tub_r
18799 vectube(3)=vectube(3)/tub_r
18800 !C calculte rdiffrence between r and r0
18803 rdiff6=rdiff**6.0d0
18804 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18805 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18806 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18807 !C print *,rdiff,rdiff6,pep_aa_tube
18808 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18809 !C now we calculate gradient
18810 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18811 6.0d0*pep_bb_tube)/rdiff6/rdiff
18812 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18814 if (acavtubpep.eq.0.0d0) then
18819 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
18821 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
18824 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
18825 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
18826 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
18827 /denominator**2.0d0
18834 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18835 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18839 do i=itube_start,itube_end
18840 enecavtube(i)=0.0d0
18841 !C Lets not jump over memory as we use many times iti
18843 !C lets ommit dummy atoms for now
18844 if ((iti.eq.ntyp1) &
18845 !C in UNRES uncomment the line below as GLY has no side-chain...
18852 vectube(1)=dmod((c(1,i+nres)),boxxsize)
18853 vectube(1)=vectube(1)+boxxsize*j
18854 vectube(2)=dmod((c(2,i+nres)),boxysize)
18855 vectube(2)=vectube(2)+boxysize*j
18856 vectube(3)=dmod((c(3,i+nres)),boxzsize)
18857 vectube(3)=vectube(3)+boxzsize*j
18860 xminact=dabs(vectube(1)-tubecenter(1))
18861 yminact=dabs(vectube(2)-tubecenter(2))
18862 zminact=dabs(vectube(3)-tubecenter(3))
18864 if (xmin.gt.xminact) then
18868 if (ymin.gt.yminact) then
18872 if (zmin.gt.zminact) then
18881 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18883 vectube(1)=vectube(1)-tubecenter(1)
18884 vectube(2)=vectube(2)-tubecenter(2)
18885 vectube(3)=vectube(3)-tubecenter(3)
18886 !C now calculte the distance
18887 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18888 !C now normalize vector
18889 vectube(1)=vectube(1)/tub_r
18890 vectube(2)=vectube(2)/tub_r
18891 vectube(3)=vectube(3)/tub_r
18893 !C calculte rdiffrence between r and r0
18896 rdiff6=rdiff**6.0d0
18897 sc_aa_tube=sc_aa_tube_par(iti)
18898 sc_bb_tube=sc_bb_tube_par(iti)
18899 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18900 !C enetube(i+nres)=0.0d0
18901 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18902 !C now we calculate gradient
18903 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18904 6.0d0*sc_bb_tube/rdiff6/rdiff
18906 !C now direction of gg_tube vector
18907 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
18908 if (acavtub(iti).eq.0.0d0) then
18910 enecavtube(i+nres)=0.0d0
18913 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
18914 enecavtube(i+nres)= &
18915 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
18917 !C enecavtube(i)=0.0
18918 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
18919 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
18920 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
18921 /denominator**2.0d0
18926 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
18927 !C & enecavtube(i),faccav
18928 !C print *,"licz=",
18929 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
18930 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
18932 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18933 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18939 do i=itube_start,itube_end
18940 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
18941 +enecavtube(i+nres)
18943 !C print *,"ETUBE", etube
18945 end subroutine calcnano
18947 !===============================================
18948 !--------------------------------------------------------------------------------
18949 !C first for shielding is setting of function of side-chains
18951 subroutine set_shield_fac2
18952 real(kind=8) :: div77_81=0.974996043d0, &
18953 div4_81=0.2222222222d0
18954 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
18955 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
18956 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
18957 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
18958 !C the vector between center of side_chain and peptide group
18959 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
18960 pept_group,costhet_grad,cosphi_grad_long, &
18961 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
18962 sh_frac_dist_grad,pep_side
18964 !C write(2,*) "ivec",ivec_start,ivec_end
18966 fac_shield(i)=0.0d0
18968 grad_shield(j,i)=0.0d0
18971 do i=ivec_start,ivec_end
18973 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
18975 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
18976 !Cif there two consequtive dummy atoms there is no peptide group between them
18977 !C the line below has to be changed for FGPROC>1
18980 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
18984 !C first lets set vector conecting the ithe side-chain with kth side-chain
18985 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
18986 !C pep_side(j)=2.0d0
18987 !C and vector conecting the side-chain with its proper calfa
18988 side_calf(j)=c(j,k+nres)-c(j,k)
18989 !C side_calf(j)=2.0d0
18990 pept_group(j)=c(j,i)-c(j,i+1)
18991 !C lets have their lenght
18992 dist_pep_side=pep_side(j)**2+dist_pep_side
18993 dist_side_calf=dist_side_calf+side_calf(j)**2
18994 dist_pept_group=dist_pept_group+pept_group(j)**2
18996 dist_pep_side=sqrt(dist_pep_side)
18997 dist_pept_group=sqrt(dist_pept_group)
18998 dist_side_calf=sqrt(dist_side_calf)
19000 pep_side_norm(j)=pep_side(j)/dist_pep_side
19001 side_calf_norm(j)=dist_side_calf
19003 !C now sscale fraction
19004 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19005 !C print *,buff_shield,"buff"
19007 if (sh_frac_dist.le.0.0) cycle
19008 !C print *,ishield_list(i),i
19009 !C If we reach here it means that this side chain reaches the shielding sphere
19010 !C Lets add him to the list for gradient
19011 ishield_list(i)=ishield_list(i)+1
19012 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19013 !C this list is essential otherwise problem would be O3
19014 shield_list(ishield_list(i),i)=k
19015 !C Lets have the sscale value
19016 if (sh_frac_dist.gt.1.0) then
19017 scale_fac_dist=1.0d0
19019 sh_frac_dist_grad(j)=0.0d0
19022 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19023 *(2.0d0*sh_frac_dist-3.0d0)
19024 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19025 /dist_pep_side/buff_shield*0.5d0
19027 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19028 !C sh_frac_dist_grad(j)=0.0d0
19029 !C scale_fac_dist=1.0d0
19030 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19031 !C & sh_frac_dist_grad(j)
19034 !C this is what is now we have the distance scaling now volume...
19035 short=short_r_sidechain(itype(k,1))
19036 long=long_r_sidechain(itype(k,1))
19037 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19038 sinthet=short/dist_pep_side*costhet
19039 !C now costhet_grad
19042 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19043 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19044 !C & -short/dist_pep_side**2/costhet)
19045 !C costhet_fac=0.0d0
19047 costhet_grad(j)=costhet_fac*pep_side(j)
19049 !C remember for the final gradient multiply costhet_grad(j)
19050 !C for side_chain by factor -2 !
19051 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19052 !C pep_side0pept_group is vector multiplication
19053 pep_side0pept_group=0.0d0
19055 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19057 cosalfa=(pep_side0pept_group/ &
19058 (dist_pep_side*dist_side_calf))
19059 fac_alfa_sin=1.0d0-cosalfa**2
19060 fac_alfa_sin=dsqrt(fac_alfa_sin)
19061 rkprim=fac_alfa_sin*(long-short)+short
19064 !C now costhet_grad
19065 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19067 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19068 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19072 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19073 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19074 *(long-short)/fac_alfa_sin*cosalfa/ &
19075 ((dist_pep_side*dist_side_calf))* &
19076 ((side_calf(j))-cosalfa* &
19077 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19078 !C cosphi_grad_long(j)=0.0d0
19079 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19080 *(long-short)/fac_alfa_sin*cosalfa &
19081 /((dist_pep_side*dist_side_calf))* &
19083 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19084 !C cosphi_grad_loc(j)=0.0d0
19086 !C print *,sinphi,sinthet
19087 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19090 !C now the gradient...
19092 grad_shield(j,i)=grad_shield(j,i) &
19093 !C gradient po skalowaniu
19094 +(sh_frac_dist_grad(j)*VofOverlap &
19095 !C gradient po costhet
19096 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19097 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19098 sinphi/sinthet*costhet*costhet_grad(j) &
19099 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19101 !C grad_shield_side is Cbeta sidechain gradient
19102 grad_shield_side(j,ishield_list(i),i)=&
19103 (sh_frac_dist_grad(j)*-2.0d0&
19105 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19106 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19107 sinphi/sinthet*costhet*costhet_grad(j)&
19108 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19111 grad_shield_loc(j,ishield_list(i),i)= &
19112 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19113 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19114 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19118 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19120 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19122 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19125 end subroutine set_shield_fac2
19126 !----------------------------------------------------------------------------
19127 ! SOUBROUTINE FOR AFM
19128 subroutine AFMvel(Eafmforce)
19129 use MD_data, only:totTafm
19130 real(kind=8),dimension(3) :: diffafm
19131 real(kind=8) :: afmdist,Eafmforce
19133 !C Only for check grad COMMENT if not used for checkgrad
19135 !C--------------------------------------------------------
19136 !C print *,"wchodze"
19140 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19141 afmdist=afmdist+diffafm(i)**2
19143 afmdist=dsqrt(afmdist)
19145 Eafmforce=0.5d0*forceAFMconst &
19146 *(distafminit+totTafm*velAFMconst-afmdist)**2
19147 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19149 gradafm(i,afmend-1)=-forceAFMconst* &
19150 (distafminit+totTafm*velAFMconst-afmdist) &
19151 *diffafm(i)/afmdist
19152 gradafm(i,afmbeg-1)=forceAFMconst* &
19153 (distafminit+totTafm*velAFMconst-afmdist) &
19154 *diffafm(i)/afmdist
19156 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19158 end subroutine AFMvel
19159 !---------------------------------------------------------
19160 subroutine AFMforce(Eafmforce)
19162 real(kind=8),dimension(3) :: diffafm
19163 ! real(kind=8) ::afmdist
19164 real(kind=8) :: afmdist,Eafmforce
19169 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19170 afmdist=afmdist+diffafm(i)**2
19172 afmdist=dsqrt(afmdist)
19173 ! print *,afmdist,distafminit
19174 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19176 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19177 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19179 !C print *,'AFM',Eafmforce
19181 end subroutine AFMforce
19183 !-----------------------------------------------------------------------------
19185 subroutine read_ssHist
19188 ! include 'DIMENSIONS'
19189 ! include "DIMENSIONS.FREE"
19190 ! include 'COMMON.FREE'
19193 character(len=80) :: controlcard
19196 call card_concat(controlcard,.true.)
19197 read(controlcard,*) &
19198 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19202 end subroutine read_ssHist
19204 !-----------------------------------------------------------------------------
19205 integer function indmat(i,j)
19207 ! get the position of the jth ijth fragment of the chain coordinate system
19208 ! in the fromto array.
19211 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19213 end function indmat
19214 !-----------------------------------------------------------------------------
19215 real(kind=8) function sigm(x)
19221 !-----------------------------------------------------------------------------
19222 !-----------------------------------------------------------------------------
19223 subroutine alloc_ener_arrays
19224 !EL Allocation of arrays used by module energy
19225 use MD_data, only: mset
19226 !el local variables
19229 if(nres.lt.100) then
19231 elseif(nres.lt.200) then
19232 maxconts=0.8*nres ! Max. number of contacts per residue
19234 maxconts=0.6*nres ! (maxconts=maxres/4)
19236 maxcont=12*nres ! Max. number of SC contacts
19237 maxvar=6*nres ! Max. number of variables
19238 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19239 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19240 !----------------------
19241 ! arrays in subroutine init_int_table
19243 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19244 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19246 allocate(nint_gr(nres))
19247 allocate(nscp_gr(nres))
19248 allocate(ielstart(nres))
19249 allocate(ielend(nres))
19251 allocate(istart(nres,maxint_gr))
19252 allocate(iend(nres,maxint_gr))
19253 !(maxres,maxint_gr)
19254 allocate(iscpstart(nres,maxint_gr))
19255 allocate(iscpend(nres,maxint_gr))
19256 !(maxres,maxint_gr)
19257 allocate(ielstart_vdw(nres))
19258 allocate(ielend_vdw(nres))
19261 allocate(lentyp(0:nfgtasks-1))
19263 !----------------------
19265 ! common /contacts/
19266 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19267 allocate(icont(2,maxcont))
19269 ! common /contacts1/
19270 allocate(num_cont(0:nres+4))
19272 allocate(jcont(maxconts,nres))
19274 allocate(facont(maxconts,nres))
19276 allocate(gacont(3,maxconts,nres))
19277 !(3,maxconts,maxres)
19278 ! common /contacts_hb/
19279 allocate(gacontp_hb1(3,maxconts,nres))
19280 allocate(gacontp_hb2(3,maxconts,nres))
19281 allocate(gacontp_hb3(3,maxconts,nres))
19282 allocate(gacontm_hb1(3,maxconts,nres))
19283 allocate(gacontm_hb2(3,maxconts,nres))
19284 allocate(gacontm_hb3(3,maxconts,nres))
19285 allocate(gacont_hbr(3,maxconts,nres))
19286 allocate(grij_hb_cont(3,maxconts,nres))
19287 !(3,maxconts,maxres)
19288 allocate(facont_hb(maxconts,nres))
19290 allocate(ees0p(maxconts,nres))
19291 allocate(ees0m(maxconts,nres))
19292 allocate(d_cont(maxconts,nres))
19293 allocate(ees0plist(maxconts,nres))
19296 allocate(num_cont_hb(nres))
19298 allocate(jcont_hb(maxconts,nres))
19301 allocate(Ug(2,2,nres))
19302 allocate(Ugder(2,2,nres))
19303 allocate(Ug2(2,2,nres))
19304 allocate(Ug2der(2,2,nres))
19306 allocate(obrot(2,nres))
19307 allocate(obrot2(2,nres))
19308 allocate(obrot_der(2,nres))
19309 allocate(obrot2_der(2,nres))
19311 ! common /precomp1/
19312 allocate(mu(2,nres))
19313 allocate(muder(2,nres))
19314 allocate(Ub2(2,nres))
19317 allocate(Ub2der(2,nres))
19318 allocate(Ctobr(2,nres))
19319 allocate(Ctobrder(2,nres))
19320 allocate(Dtobr2(2,nres))
19321 allocate(Dtobr2der(2,nres))
19323 allocate(EUg(2,2,nres))
19324 allocate(EUgder(2,2,nres))
19325 allocate(CUg(2,2,nres))
19326 allocate(CUgder(2,2,nres))
19327 allocate(DUg(2,2,nres))
19328 allocate(Dugder(2,2,nres))
19329 allocate(DtUg2(2,2,nres))
19330 allocate(DtUg2der(2,2,nres))
19332 ! common /precomp2/
19333 allocate(Ug2Db1t(2,nres))
19334 allocate(Ug2Db1tder(2,nres))
19335 allocate(CUgb2(2,nres))
19336 allocate(CUgb2der(2,nres))
19338 allocate(EUgC(2,2,nres))
19339 allocate(EUgCder(2,2,nres))
19340 allocate(EUgD(2,2,nres))
19341 allocate(EUgDder(2,2,nres))
19342 allocate(DtUg2EUg(2,2,nres))
19343 allocate(Ug2DtEUg(2,2,nres))
19345 allocate(Ug2DtEUgder(2,2,2,nres))
19346 allocate(DtUg2EUgder(2,2,2,nres))
19348 ! common /rotat_old/
19349 allocate(costab(nres))
19350 allocate(sintab(nres))
19351 allocate(costab2(nres))
19352 allocate(sintab2(nres))
19355 allocate(a_chuj(2,2,maxconts,nres))
19356 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19357 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19358 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19359 ! common /contdistrib/
19360 allocate(ncont_sent(nres))
19361 allocate(ncont_recv(nres))
19363 allocate(iat_sent(nres))
19365 allocate(iint_sent(4,nres,nres))
19366 allocate(iint_sent_local(4,nres,nres))
19368 allocate(iturn3_sent(4,0:nres+4))
19369 allocate(iturn4_sent(4,0:nres+4))
19370 allocate(iturn3_sent_local(4,nres))
19371 allocate(iturn4_sent_local(4,nres))
19373 allocate(itask_cont_from(0:nfgtasks-1))
19374 allocate(itask_cont_to(0:nfgtasks-1))
19375 !(0:max_fg_procs-1)
19379 !----------------------
19382 allocate(dcdv(6,maxdim))
19383 allocate(dxdv(6,maxdim))
19385 allocate(dxds(6,nres))
19387 allocate(gradx(3,-1:nres,0:2))
19388 allocate(gradc(3,-1:nres,0:2))
19390 allocate(gvdwx(3,-1:nres))
19391 allocate(gvdwc(3,-1:nres))
19392 allocate(gelc(3,-1:nres))
19393 allocate(gelc_long(3,-1:nres))
19394 allocate(gvdwpp(3,-1:nres))
19395 allocate(gvdwc_scpp(3,-1:nres))
19396 allocate(gradx_scp(3,-1:nres))
19397 allocate(gvdwc_scp(3,-1:nres))
19398 allocate(ghpbx(3,-1:nres))
19399 allocate(ghpbc(3,-1:nres))
19400 allocate(gradcorr(3,-1:nres))
19401 allocate(gradcorr_long(3,-1:nres))
19402 allocate(gradcorr5_long(3,-1:nres))
19403 allocate(gradcorr6_long(3,-1:nres))
19404 allocate(gcorr6_turn_long(3,-1:nres))
19405 allocate(gradxorr(3,-1:nres))
19406 allocate(gradcorr5(3,-1:nres))
19407 allocate(gradcorr6(3,-1:nres))
19408 allocate(gliptran(3,-1:nres))
19409 allocate(gliptranc(3,-1:nres))
19410 allocate(gliptranx(3,-1:nres))
19411 allocate(gshieldx(3,-1:nres))
19412 allocate(gshieldc(3,-1:nres))
19413 allocate(gshieldc_loc(3,-1:nres))
19414 allocate(gshieldx_ec(3,-1:nres))
19415 allocate(gshieldc_ec(3,-1:nres))
19416 allocate(gshieldc_loc_ec(3,-1:nres))
19417 allocate(gshieldx_t3(3,-1:nres))
19418 allocate(gshieldc_t3(3,-1:nres))
19419 allocate(gshieldc_loc_t3(3,-1:nres))
19420 allocate(gshieldx_t4(3,-1:nres))
19421 allocate(gshieldc_t4(3,-1:nres))
19422 allocate(gshieldc_loc_t4(3,-1:nres))
19423 allocate(gshieldx_ll(3,-1:nres))
19424 allocate(gshieldc_ll(3,-1:nres))
19425 allocate(gshieldc_loc_ll(3,-1:nres))
19426 allocate(grad_shield(3,-1:nres))
19427 allocate(gg_tube_sc(3,-1:nres))
19428 allocate(gg_tube(3,-1:nres))
19429 allocate(gradafm(3,-1:nres))
19431 allocate(grad_shield_side(3,50,nres))
19432 allocate(grad_shield_loc(3,50,nres))
19433 ! grad for shielding surroing
19434 allocate(gloc(0:maxvar,0:2))
19435 allocate(gloc_x(0:maxvar,2))
19437 allocate(gel_loc(3,-1:nres))
19438 allocate(gel_loc_long(3,-1:nres))
19439 allocate(gcorr3_turn(3,-1:nres))
19440 allocate(gcorr4_turn(3,-1:nres))
19441 allocate(gcorr6_turn(3,-1:nres))
19442 allocate(gradb(3,-1:nres))
19443 allocate(gradbx(3,-1:nres))
19445 allocate(gel_loc_loc(maxvar))
19446 allocate(gel_loc_turn3(maxvar))
19447 allocate(gel_loc_turn4(maxvar))
19448 allocate(gel_loc_turn6(maxvar))
19449 allocate(gcorr_loc(maxvar))
19450 allocate(g_corr5_loc(maxvar))
19451 allocate(g_corr6_loc(maxvar))
19453 allocate(gsccorc(3,-1:nres))
19454 allocate(gsccorx(3,-1:nres))
19456 allocate(gsccor_loc(-1:nres))
19458 allocate(dtheta(3,2,-1:nres))
19460 allocate(gscloc(3,-1:nres))
19461 allocate(gsclocx(3,-1:nres))
19463 allocate(dphi(3,3,-1:nres))
19464 allocate(dalpha(3,3,-1:nres))
19465 allocate(domega(3,3,-1:nres))
19467 ! common /deriv_scloc/
19468 allocate(dXX_C1tab(3,nres))
19469 allocate(dYY_C1tab(3,nres))
19470 allocate(dZZ_C1tab(3,nres))
19471 allocate(dXX_Ctab(3,nres))
19472 allocate(dYY_Ctab(3,nres))
19473 allocate(dZZ_Ctab(3,nres))
19474 allocate(dXX_XYZtab(3,nres))
19475 allocate(dYY_XYZtab(3,nres))
19476 allocate(dZZ_XYZtab(3,nres))
19479 allocate(jgrad_start(nres))
19480 allocate(jgrad_end(nres))
19482 !----------------------
19485 allocate(ibond_displ(0:nfgtasks-1))
19486 allocate(ibond_count(0:nfgtasks-1))
19487 allocate(ithet_displ(0:nfgtasks-1))
19488 allocate(ithet_count(0:nfgtasks-1))
19489 allocate(iphi_displ(0:nfgtasks-1))
19490 allocate(iphi_count(0:nfgtasks-1))
19491 allocate(iphi1_displ(0:nfgtasks-1))
19492 allocate(iphi1_count(0:nfgtasks-1))
19493 allocate(ivec_displ(0:nfgtasks-1))
19494 allocate(ivec_count(0:nfgtasks-1))
19495 allocate(iset_displ(0:nfgtasks-1))
19496 allocate(iset_count(0:nfgtasks-1))
19497 allocate(iint_count(0:nfgtasks-1))
19498 allocate(iint_displ(0:nfgtasks-1))
19499 !(0:max_fg_procs-1)
19500 !----------------------
19503 allocate(gcart(3,-1:nres))
19504 allocate(gxcart(3,-1:nres))
19506 allocate(gradcag(3,-1:nres))
19507 allocate(gradxag(3,-1:nres))
19509 ! common /back_constr/
19510 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19511 allocate(dutheta(nres))
19512 allocate(dugamma(nres))
19514 allocate(duscdiff(3,nres))
19515 allocate(duscdiffx(3,nres))
19517 !el i io:read_fragments
19518 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19519 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19521 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19522 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19523 allocate(mset(0:nprocs)) !(maxprocs/20)
19525 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19526 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19527 allocate(dUdconst(3,0:nres))
19528 allocate(dUdxconst(3,0:nres))
19529 allocate(dqwol(3,0:nres))
19530 allocate(dxqwol(3,0:nres))
19532 !----------------------
19534 ! common /sbridge/ in io_common: read_bridge
19535 !el allocate((:),allocatable :: iss !(maxss)
19536 ! common /links/ in io_common: read_bridge
19537 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19538 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19539 ! common /dyn_ssbond/
19540 ! and side-chain vectors in theta or phi.
19541 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19545 dyn_ssbond_ij(:,:)=1.0d300
19549 ! if (nss.gt.0) then
19550 allocate(idssb(maxdim),jdssb(maxdim))
19551 ! allocate(newihpb(nss),newjhpb(nss))
19554 allocate(ishield_list(nres))
19555 allocate(shield_list(50,nres))
19556 allocate(dyn_ss_mask(nres))
19557 allocate(fac_shield(nres))
19559 dyn_ss_mask(:)=.false.
19560 !----------------------
19562 ! Parameters of the SCCOR term
19564 !el in io_conf: parmread
19565 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19566 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19567 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19568 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19569 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19570 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19571 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19572 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19573 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19575 allocate(gloc_sc(3,0:2*nres,0:10))
19576 !(3,0:maxres2,10)maxres2=2*maxres
19577 allocate(dcostau(3,3,3,2*nres))
19578 allocate(dsintau(3,3,3,2*nres))
19579 allocate(dtauangle(3,3,3,2*nres))
19580 allocate(dcosomicron(3,3,3,2*nres))
19581 allocate(domicron(3,3,3,2*nres))
19582 !(3,3,3,maxres2)maxres2=2*maxres
19583 !----------------------
19586 allocate(varall(maxvar))
19587 !(maxvar)(maxvar=6*maxres)
19588 allocate(mask_theta(nres))
19589 allocate(mask_phi(nres))
19590 allocate(mask_side(nres))
19592 !----------------------
19595 allocate(uy(3,nres))
19596 allocate(uz(3,nres))
19598 allocate(uygrad(3,3,2,nres))
19599 allocate(uzgrad(3,3,2,nres))
19603 end subroutine alloc_ener_arrays
19604 !-----------------------------------------------------------------------------
19605 !-----------------------------------------------------------------------------