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
5188 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5194 end subroutine ebond
5196 !-----------------------------------------------------------------------------
5197 subroutine ebend(etheta)
5199 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5200 ! angles gamma and its derivatives in consecutive thetas and gammas.
5203 ! implicit real*8 (a-h,o-z)
5204 ! include 'DIMENSIONS'
5205 ! include 'COMMON.LOCAL'
5206 ! include 'COMMON.GEO'
5207 ! include 'COMMON.INTERACT'
5208 ! include 'COMMON.DERIV'
5209 ! include 'COMMON.VAR'
5210 ! include 'COMMON.CHAIN'
5211 ! include 'COMMON.IOUNITS'
5212 ! include 'COMMON.NAMES'
5213 ! include 'COMMON.FFIELD'
5214 ! include 'COMMON.CONTROL'
5215 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5216 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5217 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5219 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5220 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5221 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5223 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5225 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5226 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5227 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5228 real(kind=8),dimension(2) :: y,z
5231 ! time11=dexp(-2*time)
5234 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5235 do i=ithet_start,ithet_end
5236 if (itype(i-1,1).eq.ntyp1) cycle
5237 ! Zero the energy function and its derivative at 0 or pi.
5238 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5240 ichir1=isign(1,itype(i-2,1))
5241 ichir2=isign(1,itype(i,1))
5242 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5243 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5244 if (itype(i-1,1).eq.10) then
5245 itype1=isign(10,itype(i-2,1))
5246 ichir11=isign(1,itype(i-2,1))
5247 ichir12=isign(1,itype(i-2,1))
5248 itype2=isign(10,itype(i,1))
5249 ichir21=isign(1,itype(i,1))
5250 ichir22=isign(1,itype(i,1))
5253 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5256 if (phii.ne.phii) phii=150.0
5266 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5269 if (phii1.ne.phii1) phii1=150.0
5281 ! Calculate the "mean" value of theta from the part of the distribution
5282 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5283 ! In following comments this theta will be referred to as t_c.
5284 thet_pred_mean=0.0d0
5286 athetk=athet(k,it,ichir1,ichir2)
5287 bthetk=bthet(k,it,ichir1,ichir2)
5289 athetk=athet(k,itype1,ichir11,ichir12)
5290 bthetk=bthet(k,itype2,ichir21,ichir22)
5292 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5294 dthett=thet_pred_mean*ssd
5295 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5296 ! Derivatives of the "mean" values in gamma1 and gamma2.
5297 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5298 +athet(2,it,ichir1,ichir2)*y(1))*ss
5299 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5300 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5302 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5303 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5304 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5305 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5307 if (theta(i).gt.pi-delta) then
5308 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5310 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5311 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5312 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5314 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5316 else if (theta(i).lt.delta) then
5317 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5318 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5319 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5321 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5322 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5325 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5328 etheta=etheta+ethetai
5329 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5331 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5332 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5333 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5335 ! Ufff.... We've done all this!!!
5337 end subroutine ebend
5338 !-----------------------------------------------------------------------------
5339 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5342 ! implicit real*8 (a-h,o-z)
5343 ! include 'DIMENSIONS'
5344 ! include 'COMMON.LOCAL'
5345 ! include 'COMMON.IOUNITS'
5346 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5347 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5348 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5350 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5352 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5353 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5354 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5356 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5357 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5359 ! Calculate the contributions to both Gaussian lobes.
5360 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5361 ! The "polynomial part" of the "standard deviation" of this part of
5365 sig=sig*thet_pred_mean+polthet(j,it)
5367 ! Derivative of the "interior part" of the "standard deviation of the"
5368 ! gamma-dependent Gaussian lobe in t_c.
5369 sigtc=3*polthet(3,it)
5371 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5374 ! Set the parameters of both Gaussian lobes of the distribution.
5375 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5376 fac=sig*sig+sigc0(it)
5379 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5380 sigsqtc=-4.0D0*sigcsq*sigtc
5381 ! print *,i,sig,sigtc,sigsqtc
5382 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5383 sigtc=-sigtc/(fac*fac)
5384 ! Following variable is sigma(t_c)**(-2)
5385 sigcsq=sigcsq*sigcsq
5387 sig0inv=1.0D0/sig0i**2
5388 delthec=thetai-thet_pred_mean
5389 delthe0=thetai-theta0i
5390 term1=-0.5D0*sigcsq*delthec*delthec
5391 term2=-0.5D0*sig0inv*delthe0*delthe0
5392 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5393 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5394 ! to the energy (this being the log of the distribution) at the end of energy
5395 ! term evaluation for this virtual-bond angle.
5396 if (term1.gt.term2) then
5398 term2=dexp(term2-termm)
5402 term1=dexp(term1-termm)
5405 ! The ratio between the gamma-independent and gamma-dependent lobes of
5406 ! the distribution is a Gaussian function of thet_pred_mean too.
5407 diffak=gthet(2,it)-thet_pred_mean
5408 ratak=diffak/gthet(3,it)**2
5409 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5410 ! Let's differentiate it in thet_pred_mean NOW.
5412 ! Now put together the distribution terms to make complete distribution.
5413 termexp=term1+ak*term2
5414 termpre=sigc+ak*sig0i
5415 ! Contribution of the bending energy from this theta is just the -log of
5416 ! the sum of the contributions from the two lobes and the pre-exponential
5417 ! factor. Simple enough, isn't it?
5418 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5419 ! NOW the derivatives!!!
5420 ! 6/6/97 Take into account the deformation.
5421 E_theta=(delthec*sigcsq*term1 &
5422 +ak*delthe0*sig0inv*term2)/termexp
5423 E_tc=((sigtc+aktc*sig0i)/termpre &
5424 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5425 aktc*term2)/termexp)
5427 end subroutine theteng
5429 !-----------------------------------------------------------------------------
5430 subroutine ebend(etheta,ethetacnstr)
5432 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5433 ! angles gamma and its derivatives in consecutive thetas and gammas.
5434 ! ab initio-derived potentials from
5435 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5437 ! implicit real*8 (a-h,o-z)
5438 ! include 'DIMENSIONS'
5439 ! include 'COMMON.LOCAL'
5440 ! include 'COMMON.GEO'
5441 ! include 'COMMON.INTERACT'
5442 ! include 'COMMON.DERIV'
5443 ! include 'COMMON.VAR'
5444 ! include 'COMMON.CHAIN'
5445 ! include 'COMMON.IOUNITS'
5446 ! include 'COMMON.NAMES'
5447 ! include 'COMMON.FFIELD'
5448 ! include 'COMMON.CONTROL'
5449 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5450 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5451 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5452 logical :: lprn=.false., lprn1=.false.
5454 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5455 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5456 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5457 ! local variables for constrains
5458 real(kind=8) :: difi,thetiii
5462 do i=ithet_start,ithet_end
5463 if (itype(i-1,1).eq.ntyp1) cycle
5464 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5465 if (iabs(itype(i+1,1)).eq.20) iblock=2
5466 if (iabs(itype(i+1,1)).ne.20) iblock=1
5470 theti2=0.5d0*theta(i)
5471 ityp2=ithetyp((itype(i-1,1)))
5473 coskt(k)=dcos(k*theti2)
5474 sinkt(k)=dsin(k*theti2)
5476 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5479 if (phii.ne.phii) phii=150.0
5483 ityp1=ithetyp((itype(i-2,1)))
5484 ! propagation of chirality for glycine type
5486 cosph1(k)=dcos(k*phii)
5487 sinph1(k)=dsin(k*phii)
5491 ityp1=ithetyp(itype(i-2,1))
5497 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5500 if (phii1.ne.phii1) phii1=150.0
5505 ityp3=ithetyp((itype(i,1)))
5507 cosph2(k)=dcos(k*phii1)
5508 sinph2(k)=dsin(k*phii1)
5512 ityp3=ithetyp(itype(i,1))
5518 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5521 ccl=cosph1(l)*cosph2(k-l)
5522 ssl=sinph1(l)*sinph2(k-l)
5523 scl=sinph1(l)*cosph2(k-l)
5524 csl=cosph1(l)*sinph2(k-l)
5525 cosph1ph2(l,k)=ccl-ssl
5526 cosph1ph2(k,l)=ccl+ssl
5527 sinph1ph2(l,k)=scl+csl
5528 sinph1ph2(k,l)=scl-csl
5532 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5533 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5534 write (iout,*) "coskt and sinkt"
5536 write (iout,*) k,coskt(k),sinkt(k)
5540 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5541 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5544 write (iout,*) "k",k,&
5545 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5549 write (iout,*) "cosph and sinph"
5551 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5553 write (iout,*) "cosph1ph2 and sinph2ph2"
5556 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5557 sinph1ph2(l,k),sinph1ph2(k,l)
5560 write(iout,*) "ethetai",ethetai
5564 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5565 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5566 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5567 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5568 ethetai=ethetai+sinkt(m)*aux
5569 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5570 dephii=dephii+k*sinkt(m)* &
5571 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5572 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5573 dephii1=dephii1+k*sinkt(m)* &
5574 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5575 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5577 write (iout,*) "m",m," k",k," bbthet", &
5578 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5579 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5580 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5581 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5585 write(iout,*) "ethetai",ethetai
5589 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5590 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5591 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5592 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5593 ethetai=ethetai+sinkt(m)*aux
5594 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5595 dephii=dephii+l*sinkt(m)* &
5596 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5597 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5598 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5599 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5600 dephii1=dephii1+(k-l)*sinkt(m)* &
5601 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5602 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5603 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5604 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5606 write (iout,*) "m",m," k",k," l",l," ffthet",&
5607 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5608 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5609 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5610 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5612 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5613 cosph1ph2(k,l)*sinkt(m),&
5614 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5622 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5623 i,theta(i)*rad2deg,phii*rad2deg,&
5624 phii1*rad2deg,ethetai
5626 etheta=etheta+ethetai
5627 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5629 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5630 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5631 gloc(nphi+i-2,icg)=wang*dethetai
5633 !-----------thete constrains
5634 ! if (tor_mode.ne.2) then
5636 !C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5637 do i=ithetaconstr_start,ithetaconstr_end
5638 itheta=itheta_constr(i)
5639 thetiii=theta(itheta)
5640 difi=pinorm(thetiii-theta_constr0(i))
5641 if (difi.gt.theta_drange(i)) then
5642 difi=difi-theta_drange(i)
5643 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5644 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5645 +for_thet_constr(i)*difi**3
5646 else if (difi.lt.-drange(i)) then
5648 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5649 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5650 +for_thet_constr(i)*difi**3
5654 if (energy_dec) then
5655 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5656 i,itheta,rad2deg*thetiii, &
5657 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5658 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5659 gloc(itheta+nphi-2,icg)
5665 end subroutine ebend
5668 !-----------------------------------------------------------------------------
5669 subroutine esc(escloc)
5670 ! Calculate the local energy of a side chain and its derivatives in the
5671 ! corresponding virtual-bond valence angles THETA and the spherical angles
5675 ! implicit real*8 (a-h,o-z)
5676 ! include 'DIMENSIONS'
5677 ! include 'COMMON.GEO'
5678 ! include 'COMMON.LOCAL'
5679 ! include 'COMMON.VAR'
5680 ! include 'COMMON.INTERACT'
5681 ! include 'COMMON.DERIV'
5682 ! include 'COMMON.CHAIN'
5683 ! include 'COMMON.IOUNITS'
5684 ! include 'COMMON.NAMES'
5685 ! include 'COMMON.FFIELD'
5686 ! include 'COMMON.CONTROL'
5687 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5688 ddersc0,ddummy,xtemp,temp
5689 !el real(kind=8) :: time11,time12,time112,theti
5690 real(kind=8) :: escloc,delta
5691 !el integer :: it,nlobit
5692 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5695 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5696 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5699 ! write (iout,'(a)') 'ESC'
5700 do i=loc_start,loc_end
5702 if (it.eq.ntyp1) cycle
5703 if (it.eq.10) goto 1
5704 nlobit=nlob(iabs(it))
5705 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5706 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5707 theti=theta(i+1)-pipol
5712 if (x(2).gt.pi-delta) then
5716 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5718 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5719 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5721 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5722 ddersc0(1),dersc(1))
5723 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5724 ddersc0(3),dersc(3))
5726 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5728 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5729 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5730 dersc0(2),esclocbi,dersc02)
5731 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5733 call splinthet(x(2),0.5d0*delta,ss,ssd)
5738 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5740 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5741 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5743 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5745 ! write (iout,*) escloci
5746 else if (x(2).lt.delta) then
5750 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5752 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5753 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5755 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5756 ddersc0(1),dersc(1))
5757 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5758 ddersc0(3),dersc(3))
5760 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5762 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5763 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5764 dersc0(2),esclocbi,dersc02)
5765 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5770 call splinthet(x(2),0.5d0*delta,ss,ssd)
5772 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5774 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5775 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5777 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5778 ! write (iout,*) escloci
5780 call enesc(x,escloci,dersc,ddummy,.false.)
5783 escloc=escloc+escloci
5784 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5786 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5788 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5790 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5791 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5796 !-----------------------------------------------------------------------------
5797 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5800 ! implicit real*8 (a-h,o-z)
5801 ! include 'DIMENSIONS'
5802 ! include 'COMMON.GEO'
5803 ! include 'COMMON.LOCAL'
5804 ! include 'COMMON.IOUNITS'
5805 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5806 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5807 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5808 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5809 real(kind=8) :: escloci
5812 integer :: j,iii,l,k !el,it,nlobit
5813 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5814 !el time11,time12,time112
5815 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5819 if (mixed) ddersc(j)=0.0d0
5823 ! Because of periodicity of the dependence of the SC energy in omega we have
5824 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5825 ! To avoid underflows, first compute & store the exponents.
5833 z(k)=x(k)-censc(k,j,it)
5838 Axk=Axk+gaussc(l,k,j,it)*z(l)
5844 expfac=expfac+Ax(k,j,iii)*z(k)
5852 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5853 ! subsequent NaNs and INFs in energy calculation.
5854 ! Find the largest exponent
5858 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5862 !d print *,'it=',it,' emin=',emin
5864 ! Compute the contribution to SC energy and derivatives
5869 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5870 if(adexp.ne.adexp) adexp=1.0
5873 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5875 !d print *,'j=',j,' expfac=',expfac
5876 escloc_i=escloc_i+expfac
5878 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5882 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
5883 +gaussc(k,2,j,it))*expfac
5890 dersc(1)=dersc(1)/cos(theti)**2
5891 ddersc(1)=ddersc(1)/cos(theti)**2
5894 escloci=-(dlog(escloc_i)-emin)
5896 dersc(j)=dersc(j)/escloc_i
5900 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5904 end subroutine enesc
5905 !-----------------------------------------------------------------------------
5906 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5909 ! implicit real*8 (a-h,o-z)
5910 ! include 'DIMENSIONS'
5911 ! include 'COMMON.GEO'
5912 ! include 'COMMON.LOCAL'
5913 ! include 'COMMON.IOUNITS'
5914 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5915 real(kind=8),dimension(3) :: x,z,dersc
5916 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
5917 real(kind=8),dimension(nlobit) :: contr !(maxlob)
5918 real(kind=8) :: escloci,dersc12,emin
5921 integer :: j,k,l !el,it,nlobit
5922 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
5932 z(k)=x(k)-censc(k,j,it)
5938 Axk=Axk+gaussc(l,k,j,it)*z(l)
5944 expfac=expfac+Ax(k,j)*z(k)
5949 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5950 ! subsequent NaNs and INFs in energy calculation.
5951 ! Find the largest exponent
5954 if (emin.gt.contr(j)) emin=contr(j)
5958 ! Compute the contribution to SC energy and derivatives
5962 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5963 escloc_i=escloc_i+expfac
5965 dersc(k)=dersc(k)+Ax(k,j)*expfac
5967 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
5968 +gaussc(1,2,j,it))*expfac
5972 dersc(1)=dersc(1)/cos(theti)**2
5973 dersc12=dersc12/cos(theti)**2
5974 escloci=-(dlog(escloc_i)-emin)
5976 dersc(j)=dersc(j)/escloc_i
5978 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5980 end subroutine enesc_bound
5982 !-----------------------------------------------------------------------------
5983 subroutine esc(escloc)
5984 ! Calculate the local energy of a side chain and its derivatives in the
5985 ! corresponding virtual-bond valence angles THETA and the spherical angles
5986 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
5987 ! added by Urszula Kozlowska. 07/11/2007
5990 ! implicit real*8 (a-h,o-z)
5991 ! include 'DIMENSIONS'
5992 ! include 'COMMON.GEO'
5993 ! include 'COMMON.LOCAL'
5994 ! include 'COMMON.VAR'
5995 ! include 'COMMON.SCROT'
5996 ! include 'COMMON.INTERACT'
5997 ! include 'COMMON.DERIV'
5998 ! include 'COMMON.CHAIN'
5999 ! include 'COMMON.IOUNITS'
6000 ! include 'COMMON.NAMES'
6001 ! include 'COMMON.FFIELD'
6002 ! include 'COMMON.CONTROL'
6003 ! include 'COMMON.VECTORS'
6004 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6005 real(kind=8),dimension(65) :: x
6006 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6007 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6008 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6009 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6010 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6012 integer :: i,j,k !el,it,nlobit
6013 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6014 !el real(kind=8) :: time11,time12,time112,theti
6015 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6016 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6017 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6018 sumene1x,sumene2x,sumene3x,sumene4x,&
6019 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6022 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6023 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6026 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6030 do i=loc_start,loc_end
6031 if (itype(i,1).eq.ntyp1) cycle
6032 costtab(i+1) =dcos(theta(i+1))
6033 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6034 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6035 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6036 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6037 cosfac=dsqrt(cosfac2)
6038 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6039 sinfac=dsqrt(sinfac2)
6041 if (it.eq.10) goto 1
6043 ! Compute the axes of tghe local cartesian coordinates system; store in
6044 ! x_prime, y_prime and z_prime
6051 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6052 ! & dc_norm(3,i+nres)
6054 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6055 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6058 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6061 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6062 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6063 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6064 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6065 ! & " xy",scalar(x_prime(1),y_prime(1)),
6066 ! & " xz",scalar(x_prime(1),z_prime(1)),
6067 ! & " yy",scalar(y_prime(1),y_prime(1)),
6068 ! & " yz",scalar(y_prime(1),z_prime(1)),
6069 ! & " zz",scalar(z_prime(1),z_prime(1))
6071 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6072 ! to local coordinate system. Store in xx, yy, zz.
6078 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6079 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6080 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6087 ! Compute the energy of the ith side cbain
6089 ! write (2,*) "xx",xx," yy",yy," zz",zz
6092 x(j) = sc_parmin(j,it)
6095 !c diagnostics - remove later
6097 yy1 = dsin(alph(2))*dcos(omeg(2))
6098 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6099 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6100 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6102 !," --- ", xx_w,yy_w,zz_w
6105 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6106 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6108 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6109 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6111 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6112 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6113 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6114 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6115 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6117 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6118 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6119 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6120 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6121 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6123 dsc_i = 0.743d0+x(61)
6125 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6126 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6127 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6128 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6129 s1=(1+x(63))/(0.1d0 + dscp1)
6130 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6131 s2=(1+x(65))/(0.1d0 + dscp2)
6132 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6133 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6134 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6135 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6137 ! & dscp1,dscp2,sumene
6138 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6139 escloc = escloc + sumene
6140 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6145 ! This section to check the numerical derivatives of the energy of ith side
6146 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6147 ! #define DEBUG in the code to turn it on.
6149 write (2,*) "sumene =",sumene
6153 write (2,*) xx,yy,zz
6154 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6155 de_dxx_num=(sumenep-sumene)/aincr
6157 write (2,*) "xx+ sumene from enesc=",sumenep
6160 write (2,*) xx,yy,zz
6161 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6162 de_dyy_num=(sumenep-sumene)/aincr
6164 write (2,*) "yy+ sumene from enesc=",sumenep
6167 write (2,*) xx,yy,zz
6168 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6169 de_dzz_num=(sumenep-sumene)/aincr
6171 write (2,*) "zz+ sumene from enesc=",sumenep
6172 costsave=cost2tab(i+1)
6173 sintsave=sint2tab(i+1)
6174 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6175 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6176 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6177 de_dt_num=(sumenep-sumene)/aincr
6178 write (2,*) " t+ sumene from enesc=",sumenep
6179 cost2tab(i+1)=costsave
6180 sint2tab(i+1)=sintsave
6181 ! End of diagnostics section.
6184 ! Compute the gradient of esc
6186 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6187 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6188 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6189 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6190 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6191 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6192 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6193 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6194 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6195 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6196 *(pom_s1/dscp1+pom_s16*dscp1**4)
6197 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6198 *(pom_s2/dscp2+pom_s26*dscp2**4)
6199 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6200 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6201 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6203 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6204 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6205 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6207 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6208 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6211 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6214 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6215 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6216 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6218 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6219 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6220 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6221 +x(59)*zz**2 +x(60)*xx*zz
6222 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6223 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6226 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6229 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6230 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6231 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6232 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6233 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6234 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6235 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6236 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6238 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6241 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6242 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6243 +pom1*pom_dt1+pom2*pom_dt2
6245 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6249 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6250 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6251 cosfac2xx=cosfac2*xx
6252 sinfac2yy=sinfac2*yy
6254 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6256 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6258 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6259 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6260 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6261 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6262 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6263 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6264 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6265 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6266 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6267 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6271 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6272 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6273 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6274 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6277 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6278 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6279 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6280 (z_prime(k)-zz*dC_norm(k,i+nres))
6282 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6283 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6287 dXX_Ctab(k,i)=dXX_Ci(k)
6288 dXX_C1tab(k,i)=dXX_Ci1(k)
6289 dYY_Ctab(k,i)=dYY_Ci(k)
6290 dYY_C1tab(k,i)=dYY_Ci1(k)
6291 dZZ_Ctab(k,i)=dZZ_Ci(k)
6292 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6293 dXX_XYZtab(k,i)=dXX_XYZ(k)
6294 dYY_XYZtab(k,i)=dYY_XYZ(k)
6295 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6299 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6300 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6301 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6302 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6303 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6305 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6306 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6307 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6308 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6309 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6310 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6311 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6312 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6314 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6315 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6317 ! to check gradient call subroutine check_grad
6323 !-----------------------------------------------------------------------------
6324 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6326 real(kind=8),dimension(65) :: x
6327 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6328 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6330 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6331 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6333 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6334 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6336 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6337 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6338 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6339 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6340 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6342 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6343 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6344 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6345 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6346 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6348 dsc_i = 0.743d0+x(61)
6350 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6351 *(xx*cost2+yy*sint2))
6352 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6353 *(xx*cost2-yy*sint2))
6354 s1=(1+x(63))/(0.1d0 + dscp1)
6355 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6356 s2=(1+x(65))/(0.1d0 + dscp2)
6357 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6358 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6359 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6364 !-----------------------------------------------------------------------------
6365 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6367 ! This procedure calculates two-body contact function g(rij) and its derivative:
6370 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6373 ! where x=(rij-r0ij)/delta
6375 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6378 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6379 real(kind=8) :: x,x2,x4,delta
6383 if (x.lt.-1.0D0) then
6386 else if (x.le.1.0D0) then
6389 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6390 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6396 end subroutine gcont
6397 !-----------------------------------------------------------------------------
6398 subroutine splinthet(theti,delta,ss,ssder)
6399 ! implicit real*8 (a-h,o-z)
6400 ! include 'DIMENSIONS'
6401 ! include 'COMMON.VAR'
6402 ! include 'COMMON.GEO'
6403 real(kind=8) :: theti,delta,ss,ssder
6404 real(kind=8) :: thetup,thetlow
6407 if (theti.gt.pipol) then
6408 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6410 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6414 end subroutine splinthet
6415 !-----------------------------------------------------------------------------
6416 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6418 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6419 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6420 a1=fprim0*delta/(f1-f0)
6426 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6427 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6429 end subroutine spline1
6430 !-----------------------------------------------------------------------------
6431 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6433 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6434 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6439 a2=3*(f1x-f0x)-2*fprim0x*delta
6440 a3=fprim0x*delta-2*(f1x-f0x)
6441 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6443 end subroutine spline2
6444 !-----------------------------------------------------------------------------
6446 !-----------------------------------------------------------------------------
6447 subroutine etor(etors,edihcnstr)
6448 ! implicit real*8 (a-h,o-z)
6449 ! include 'DIMENSIONS'
6450 ! include 'COMMON.VAR'
6451 ! include 'COMMON.GEO'
6452 ! include 'COMMON.LOCAL'
6453 ! include 'COMMON.TORSION'
6454 ! include 'COMMON.INTERACT'
6455 ! include 'COMMON.DERIV'
6456 ! include 'COMMON.CHAIN'
6457 ! include 'COMMON.NAMES'
6458 ! include 'COMMON.IOUNITS'
6459 ! include 'COMMON.FFIELD'
6460 ! include 'COMMON.TORCNSTR'
6461 ! include 'COMMON.CONTROL'
6462 real(kind=8) :: etors,edihcnstr
6466 real(kind=8) :: phii,fac,etors_ii
6468 ! Set lprn=.true. for debugging
6472 do i=iphi_start,iphi_end
6474 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6475 .or. itype(i,1).eq.ntyp1) cycle
6476 itori=itortyp(itype(i-2,1))
6477 itori1=itortyp(itype(i-1,1))
6480 ! Proline-Proline pair is a special case...
6481 if (itori.eq.3 .and. itori1.eq.3) then
6482 if (phii.gt.-dwapi3) then
6484 fac=1.0D0/(1.0D0-cosphi)
6485 etorsi=v1(1,3,3)*fac
6486 etorsi=etorsi+etorsi
6487 etors=etors+etorsi-v1(1,3,3)
6488 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6489 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6492 v1ij=v1(j+1,itori,itori1)
6493 v2ij=v2(j+1,itori,itori1)
6496 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6497 if (energy_dec) etors_ii=etors_ii+ &
6498 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6499 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6503 v1ij=v1(j,itori,itori1)
6504 v2ij=v2(j,itori,itori1)
6507 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6508 if (energy_dec) etors_ii=etors_ii+ &
6509 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6510 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6513 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6516 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6517 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6518 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6519 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6520 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6522 ! 6/20/98 - dihedral angle constraints
6525 itori=idih_constr(i)
6528 if (difi.gt.drange(i)) then
6530 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6531 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6532 else if (difi.lt.-drange(i)) then
6534 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6535 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6537 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6538 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6540 ! write (iout,*) 'edihcnstr',edihcnstr
6543 !-----------------------------------------------------------------------------
6544 subroutine etor_d(etors_d)
6545 real(kind=8) :: etors_d
6548 end subroutine etor_d
6550 !-----------------------------------------------------------------------------
6551 subroutine etor(etors,edihcnstr)
6552 ! implicit real*8 (a-h,o-z)
6553 ! include 'DIMENSIONS'
6554 ! include 'COMMON.VAR'
6555 ! include 'COMMON.GEO'
6556 ! include 'COMMON.LOCAL'
6557 ! include 'COMMON.TORSION'
6558 ! include 'COMMON.INTERACT'
6559 ! include 'COMMON.DERIV'
6560 ! include 'COMMON.CHAIN'
6561 ! include 'COMMON.NAMES'
6562 ! include 'COMMON.IOUNITS'
6563 ! include 'COMMON.FFIELD'
6564 ! include 'COMMON.TORCNSTR'
6565 ! include 'COMMON.CONTROL'
6566 real(kind=8) :: etors,edihcnstr
6569 integer :: i,j,iblock,itori,itori1
6570 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6571 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6572 ! Set lprn=.true. for debugging
6576 do i=iphi_start,iphi_end
6577 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6578 .or. itype(i-3,1).eq.ntyp1 &
6579 .or. itype(i,1).eq.ntyp1) cycle
6581 if (iabs(itype(i,1)).eq.20) then
6586 itori=itortyp(itype(i-2,1))
6587 itori1=itortyp(itype(i-1,1))
6590 ! Regular cosine and sine terms
6591 do j=1,nterm(itori,itori1,iblock)
6592 v1ij=v1(j,itori,itori1,iblock)
6593 v2ij=v2(j,itori,itori1,iblock)
6596 etors=etors+v1ij*cosphi+v2ij*sinphi
6597 if (energy_dec) etors_ii=etors_ii+ &
6598 v1ij*cosphi+v2ij*sinphi
6599 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6603 ! E = SUM ----------------------------------- - v1
6604 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6606 cosphi=dcos(0.5d0*phii)
6607 sinphi=dsin(0.5d0*phii)
6608 do j=1,nlor(itori,itori1,iblock)
6609 vl1ij=vlor1(j,itori,itori1)
6610 vl2ij=vlor2(j,itori,itori1)
6611 vl3ij=vlor3(j,itori,itori1)
6612 pom=vl2ij*cosphi+vl3ij*sinphi
6613 pom1=1.0d0/(pom*pom+1.0d0)
6614 etors=etors+vl1ij*pom1
6615 if (energy_dec) etors_ii=etors_ii+ &
6618 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6620 ! Subtract the constant term
6621 etors=etors-v0(itori,itori1,iblock)
6622 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6623 'etor',i,etors_ii-v0(itori,itori1,iblock)
6625 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6626 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6627 (v1(j,itori,itori1,iblock),j=1,6),&
6628 (v2(j,itori,itori1,iblock),j=1,6)
6629 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6630 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6632 ! 6/20/98 - dihedral angle constraints
6634 ! do i=1,ndih_constr
6635 do i=idihconstr_start,idihconstr_end
6636 itori=idih_constr(i)
6638 difi=pinorm(phii-phi0(i))
6639 if (difi.gt.drange(i)) then
6641 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6642 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6643 else if (difi.lt.-drange(i)) then
6645 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6646 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6650 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6651 !d & rad2deg*phi0(i), rad2deg*drange(i),
6652 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6654 !d write (iout,*) 'edihcnstr',edihcnstr
6657 !-----------------------------------------------------------------------------
6658 subroutine etor_d(etors_d)
6659 ! 6/23/01 Compute double torsional energy
6660 ! implicit real*8 (a-h,o-z)
6661 ! include 'DIMENSIONS'
6662 ! include 'COMMON.VAR'
6663 ! include 'COMMON.GEO'
6664 ! include 'COMMON.LOCAL'
6665 ! include 'COMMON.TORSION'
6666 ! include 'COMMON.INTERACT'
6667 ! include 'COMMON.DERIV'
6668 ! include 'COMMON.CHAIN'
6669 ! include 'COMMON.NAMES'
6670 ! include 'COMMON.IOUNITS'
6671 ! include 'COMMON.FFIELD'
6672 ! include 'COMMON.TORCNSTR'
6673 real(kind=8) :: etors_d,etors_d_ii
6676 integer :: i,j,k,l,itori,itori1,itori2,iblock
6677 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6678 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6679 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6680 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6681 ! Set lprn=.true. for debugging
6685 ! write(iout,*) "a tu??"
6686 do i=iphid_start,iphid_end
6688 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6689 .or. itype(i-3,1).eq.ntyp1 &
6690 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6691 itori=itortyp(itype(i-2,1))
6692 itori1=itortyp(itype(i-1,1))
6693 itori2=itortyp(itype(i,1))
6699 if (iabs(itype(i+1,1)).eq.20) iblock=2
6701 ! Regular cosine and sine terms
6702 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6703 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6704 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6705 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6706 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6707 cosphi1=dcos(j*phii)
6708 sinphi1=dsin(j*phii)
6709 cosphi2=dcos(j*phii1)
6710 sinphi2=dsin(j*phii1)
6711 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6712 v2cij*cosphi2+v2sij*sinphi2
6713 if (energy_dec) etors_d_ii=etors_d_ii+ &
6714 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6715 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6716 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6718 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6720 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6721 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6722 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6723 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6724 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6725 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6726 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6727 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6728 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6729 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6730 if (energy_dec) etors_d_ii=etors_d_ii+ &
6731 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6732 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6733 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6734 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6735 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6736 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6739 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6740 'etor_d',i,etors_d_ii
6741 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6742 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6745 end subroutine etor_d
6747 !-----------------------------------------------------------------------------
6748 subroutine eback_sc_corr(esccor)
6749 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6750 ! conformational states; temporarily implemented as differences
6751 ! between UNRES torsional potentials (dependent on three types of
6752 ! residues) and the torsional potentials dependent on all 20 types
6753 ! of residues computed from AM1 energy surfaces of terminally-blocked
6754 ! amino-acid residues.
6755 ! implicit real*8 (a-h,o-z)
6756 ! include 'DIMENSIONS'
6757 ! include 'COMMON.VAR'
6758 ! include 'COMMON.GEO'
6759 ! include 'COMMON.LOCAL'
6760 ! include 'COMMON.TORSION'
6761 ! include 'COMMON.SCCOR'
6762 ! include 'COMMON.INTERACT'
6763 ! include 'COMMON.DERIV'
6764 ! include 'COMMON.CHAIN'
6765 ! include 'COMMON.NAMES'
6766 ! include 'COMMON.IOUNITS'
6767 ! include 'COMMON.FFIELD'
6768 ! include 'COMMON.CONTROL'
6769 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
6772 integer :: i,interty,j,isccori,isccori1,intertyp
6773 ! Set lprn=.true. for debugging
6776 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6778 do i=itau_start,itau_end
6779 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
6781 isccori=isccortyp(itype(i-2,1))
6782 isccori1=isccortyp(itype(i-1,1))
6784 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6786 do intertyp=1,3 !intertyp
6788 !c Added 09 May 2012 (Adasko)
6789 !c Intertyp means interaction type of backbone mainchain correlation:
6790 ! 1 = SC...Ca...Ca...Ca
6791 ! 2 = Ca...Ca...Ca...SC
6792 ! 3 = SC...Ca...Ca...SCi
6794 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
6795 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
6796 (itype(i-1,1).eq.ntyp1))) &
6797 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
6798 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
6799 .or.(itype(i,1).eq.ntyp1))) &
6800 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
6801 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
6802 (itype(i-3,1).eq.ntyp1)))) cycle
6803 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
6804 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
6806 do j=1,nterm_sccor(isccori,isccori1)
6807 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6808 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6809 cosphi=dcos(j*tauangle(intertyp,i))
6810 sinphi=dsin(j*tauangle(intertyp,i))
6811 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6812 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6813 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6815 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6816 'esccor',i,intertyp,esccor_ii
6817 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6818 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6820 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6821 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
6822 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6823 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6824 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6829 end subroutine eback_sc_corr
6830 !-----------------------------------------------------------------------------
6831 subroutine multibody(ecorr)
6832 ! This subroutine calculates multi-body contributions to energy following
6833 ! the idea of Skolnick et al. If side chains I and J make a contact and
6834 ! at the same time side chains I+1 and J+1 make a contact, an extra
6835 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6836 ! implicit real*8 (a-h,o-z)
6837 ! include 'DIMENSIONS'
6838 ! include 'COMMON.IOUNITS'
6839 ! include 'COMMON.DERIV'
6840 ! include 'COMMON.INTERACT'
6841 ! include 'COMMON.CONTACTS'
6842 real(kind=8),dimension(3) :: gx,gx1
6844 real(kind=8) :: ecorr
6845 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
6846 ! Set lprn=.true. for debugging
6850 write (iout,'(a)') 'Contact function values:'
6852 write (iout,'(i2,20(1x,i2,f10.5))') &
6853 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6858 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6859 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6871 num_conti=num_cont(i)
6872 num_conti1=num_cont(i1)
6877 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6878 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6879 !d & ' ishift=',ishift
6880 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6881 ! The system gains extra energy.
6882 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6883 endif ! j1==j+-ishift
6891 end subroutine multibody
6892 !-----------------------------------------------------------------------------
6893 real(kind=8) function esccorr(i,j,k,l,jj,kk)
6894 ! implicit real*8 (a-h,o-z)
6895 ! include 'DIMENSIONS'
6896 ! include 'COMMON.IOUNITS'
6897 ! include 'COMMON.DERIV'
6898 ! include 'COMMON.INTERACT'
6899 ! include 'COMMON.CONTACTS'
6900 real(kind=8),dimension(3) :: gx,gx1
6902 integer :: i,j,k,l,jj,kk,m,ll
6903 real(kind=8) :: eij,ekl
6907 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6908 ! Calculate the multi-body contribution to energy.
6909 ! Calculate multi-body contributions to the gradient.
6910 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6911 !d & k,l,(gacont(m,kk,k),m=1,3)
6913 gx(m) =ekl*gacont(m,jj,i)
6914 gx1(m)=eij*gacont(m,kk,k)
6915 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6916 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6917 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6918 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6922 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6927 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6932 end function esccorr
6933 !-----------------------------------------------------------------------------
6934 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6935 ! This subroutine calculates multi-body contributions to hydrogen-bonding
6936 ! implicit real*8 (a-h,o-z)
6937 ! include 'DIMENSIONS'
6938 ! include 'COMMON.IOUNITS'
6941 ! integer :: maxconts !max_cont=maxconts =nres/4
6942 integer,parameter :: max_dim=26
6943 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6944 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
6945 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
6946 !el common /przechowalnia/ zapas
6947 integer :: status(MPI_STATUS_SIZE)
6948 integer,dimension((nres/4)*2) :: req !maxconts*2
6949 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
6951 ! include 'COMMON.SETUP'
6952 ! include 'COMMON.FFIELD'
6953 ! include 'COMMON.DERIV'
6954 ! include 'COMMON.INTERACT'
6955 ! include 'COMMON.CONTACTS'
6956 ! include 'COMMON.CONTROL'
6957 ! include 'COMMON.LOCAL'
6958 real(kind=8),dimension(3) :: gx,gx1
6959 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
6960 logical :: lprn,ldone
6962 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
6963 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
6965 ! Set lprn=.true. for debugging
6969 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
6972 if (nfgtasks.le.1) goto 30
6974 write (iout,'(a)') 'Contact function values before RECEIVE:'
6976 write (iout,'(2i3,50(1x,i2,f5.2))') &
6977 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
6982 do i=1,ntask_cont_from
6985 do i=1,ntask_cont_to
6988 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6990 ! Make the list of contacts to send to send to other procesors
6991 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6993 do i=iturn3_start,iturn3_end
6994 ! write (iout,*) "make contact list turn3",i," num_cont",
6996 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6998 do i=iturn4_start,iturn4_end
6999 ! write (iout,*) "make contact list turn4",i," num_cont",
7001 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7005 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7007 do j=1,num_cont_hb(i)
7010 iproc=iint_sent_local(k,jjc,ii)
7011 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7012 if (iproc.gt.0) then
7013 ncont_sent(iproc)=ncont_sent(iproc)+1
7014 nn=ncont_sent(iproc)
7016 zapas(2,nn,iproc)=jjc
7017 zapas(3,nn,iproc)=facont_hb(j,i)
7018 zapas(4,nn,iproc)=ees0p(j,i)
7019 zapas(5,nn,iproc)=ees0m(j,i)
7020 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7021 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7022 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7023 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7024 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7025 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7026 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7027 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7028 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7029 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7030 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7031 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7032 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7033 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7034 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7035 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7036 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7037 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7038 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7039 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7040 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7047 "Numbers of contacts to be sent to other processors",&
7048 (ncont_sent(i),i=1,ntask_cont_to)
7049 write (iout,*) "Contacts sent"
7050 do ii=1,ntask_cont_to
7052 iproc=itask_cont_to(ii)
7053 write (iout,*) nn," contacts to processor",iproc,&
7054 " of CONT_TO_COMM group"
7056 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7064 CorrelID1=nfgtasks+fg_rank+1
7066 ! Receive the numbers of needed contacts from other processors
7067 do ii=1,ntask_cont_from
7068 iproc=itask_cont_from(ii)
7070 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7071 FG_COMM,req(ireq),IERR)
7073 ! write (iout,*) "IRECV ended"
7075 ! Send the number of contacts needed by other processors
7076 do ii=1,ntask_cont_to
7077 iproc=itask_cont_to(ii)
7079 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7080 FG_COMM,req(ireq),IERR)
7082 ! write (iout,*) "ISEND ended"
7083 ! write (iout,*) "number of requests (nn)",ireq
7086 call MPI_Waitall(ireq,req,status_array,ierr)
7088 ! & "Numbers of contacts to be received from other processors",
7089 ! & (ncont_recv(i),i=1,ntask_cont_from)
7093 do ii=1,ntask_cont_from
7094 iproc=itask_cont_from(ii)
7096 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7097 ! & " of CONT_TO_COMM group"
7101 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7102 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7103 ! write (iout,*) "ireq,req",ireq,req(ireq)
7106 ! Send the contacts to processors that need them
7107 do ii=1,ntask_cont_to
7108 iproc=itask_cont_to(ii)
7110 ! write (iout,*) nn," contacts to processor",iproc,
7111 ! & " of CONT_TO_COMM group"
7114 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7115 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7116 ! write (iout,*) "ireq,req",ireq,req(ireq)
7118 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7122 ! write (iout,*) "number of requests (contacts)",ireq
7123 ! write (iout,*) "req",(req(i),i=1,4)
7126 call MPI_Waitall(ireq,req,status_array,ierr)
7127 do iii=1,ntask_cont_from
7128 iproc=itask_cont_from(iii)
7131 write (iout,*) "Received",nn," contacts from processor",iproc,&
7132 " of CONT_FROM_COMM group"
7135 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7140 ii=zapas_recv(1,i,iii)
7141 ! Flag the received contacts to prevent double-counting
7142 jj=-zapas_recv(2,i,iii)
7143 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7145 nnn=num_cont_hb(ii)+1
7148 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7149 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7150 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7151 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7152 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7153 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7154 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7155 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7156 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7157 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7158 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7159 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7160 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7161 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7162 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7163 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7164 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7165 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7166 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7167 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7168 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7169 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7170 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7171 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7176 write (iout,'(a)') 'Contact function values after receive:'
7178 write (iout,'(2i3,50(1x,i3,f5.2))') &
7179 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7187 write (iout,'(a)') 'Contact function values:'
7189 write (iout,'(2i3,50(1x,i3,f5.2))') &
7190 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7196 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7197 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7198 ! Remove the loop below after debugging !!!
7205 ! Calculate the local-electrostatic correlation terms
7206 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7208 num_conti=num_cont_hb(i)
7209 num_conti1=num_cont_hb(i+1)
7216 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7217 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7218 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7219 .or. j.lt.0 .and. j1.gt.0) .and. &
7220 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7221 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7222 ! The system gains extra energy.
7223 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7224 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7225 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7227 else if (j1.eq.j) then
7228 ! Contacts I-J and I-(J+1) occur simultaneously.
7229 ! The system loses extra energy.
7230 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7235 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7236 ! & ' jj=',jj,' kk=',kk
7238 ! Contacts I-J and (I+1)-J occur simultaneously.
7239 ! The system loses extra energy.
7240 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7246 end subroutine multibody_hb
7247 !-----------------------------------------------------------------------------
7248 subroutine add_hb_contact(ii,jj,itask)
7249 ! implicit real*8 (a-h,o-z)
7250 ! include "DIMENSIONS"
7251 ! include "COMMON.IOUNITS"
7252 ! include "COMMON.CONTACTS"
7253 ! integer,parameter :: maxconts=nres/4
7254 integer,parameter :: max_dim=26
7255 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7256 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7257 ! common /przechowalnia/ zapas
7258 integer :: i,j,ii,jj,iproc,nn,jjc
7259 integer,dimension(4) :: itask
7260 ! write (iout,*) "itask",itask
7263 if (iproc.gt.0) then
7264 do j=1,num_cont_hb(ii)
7266 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7268 ncont_sent(iproc)=ncont_sent(iproc)+1
7269 nn=ncont_sent(iproc)
7270 zapas(1,nn,iproc)=ii
7271 zapas(2,nn,iproc)=jjc
7272 zapas(3,nn,iproc)=facont_hb(j,ii)
7273 zapas(4,nn,iproc)=ees0p(j,ii)
7274 zapas(5,nn,iproc)=ees0m(j,ii)
7275 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7276 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7277 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7278 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7279 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7280 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7281 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7282 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7283 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7284 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7285 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7286 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7287 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7288 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7289 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7290 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7291 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7292 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7293 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7294 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7295 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7302 end subroutine add_hb_contact
7303 !-----------------------------------------------------------------------------
7304 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7305 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7306 ! implicit real*8 (a-h,o-z)
7307 ! include 'DIMENSIONS'
7308 ! include 'COMMON.IOUNITS'
7309 integer,parameter :: max_dim=70
7312 ! integer :: maxconts !max_cont=maxconts=nres/4
7313 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7314 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7315 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7316 ! common /przechowalnia/ zapas
7317 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7318 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7321 ! include 'COMMON.SETUP'
7322 ! include 'COMMON.FFIELD'
7323 ! include 'COMMON.DERIV'
7324 ! include 'COMMON.LOCAL'
7325 ! include 'COMMON.INTERACT'
7326 ! include 'COMMON.CONTACTS'
7327 ! include 'COMMON.CHAIN'
7328 ! include 'COMMON.CONTROL'
7329 real(kind=8),dimension(3) :: gx,gx1
7330 integer,dimension(nres) :: num_cont_hb_old
7331 logical :: lprn,ldone
7332 !EL double precision eello4,eello5,eelo6,eello_turn6
7333 !EL external eello4,eello5,eello6,eello_turn6
7335 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7336 j1,jp1,i1,num_conti1
7337 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7338 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7340 ! Set lprn=.true. for debugging
7345 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7347 num_cont_hb_old(i)=num_cont_hb(i)
7351 if (nfgtasks.le.1) goto 30
7353 write (iout,'(a)') 'Contact function values before RECEIVE:'
7355 write (iout,'(2i3,50(1x,i2,f5.2))') &
7356 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7361 do i=1,ntask_cont_from
7364 do i=1,ntask_cont_to
7367 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7369 ! Make the list of contacts to send to send to other procesors
7370 do i=iturn3_start,iturn3_end
7371 ! write (iout,*) "make contact list turn3",i," num_cont",
7373 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7375 do i=iturn4_start,iturn4_end
7376 ! write (iout,*) "make contact list turn4",i," num_cont",
7378 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7382 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7384 do j=1,num_cont_hb(i)
7387 iproc=iint_sent_local(k,jjc,ii)
7388 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7389 if (iproc.ne.0) then
7390 ncont_sent(iproc)=ncont_sent(iproc)+1
7391 nn=ncont_sent(iproc)
7393 zapas(2,nn,iproc)=jjc
7394 zapas(3,nn,iproc)=d_cont(j,i)
7398 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7403 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7411 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7422 "Numbers of contacts to be sent to other processors",&
7423 (ncont_sent(i),i=1,ntask_cont_to)
7424 write (iout,*) "Contacts sent"
7425 do ii=1,ntask_cont_to
7427 iproc=itask_cont_to(ii)
7428 write (iout,*) nn," contacts to processor",iproc,&
7429 " of CONT_TO_COMM group"
7431 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7439 CorrelID1=nfgtasks+fg_rank+1
7441 ! Receive the numbers of needed contacts from other processors
7442 do ii=1,ntask_cont_from
7443 iproc=itask_cont_from(ii)
7445 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7446 FG_COMM,req(ireq),IERR)
7448 ! write (iout,*) "IRECV ended"
7450 ! Send the number of contacts needed by other processors
7451 do ii=1,ntask_cont_to
7452 iproc=itask_cont_to(ii)
7454 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7455 FG_COMM,req(ireq),IERR)
7457 ! write (iout,*) "ISEND ended"
7458 ! write (iout,*) "number of requests (nn)",ireq
7461 call MPI_Waitall(ireq,req,status_array,ierr)
7463 ! & "Numbers of contacts to be received from other processors",
7464 ! & (ncont_recv(i),i=1,ntask_cont_from)
7468 do ii=1,ntask_cont_from
7469 iproc=itask_cont_from(ii)
7471 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7472 ! & " of CONT_TO_COMM group"
7476 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7477 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7478 ! write (iout,*) "ireq,req",ireq,req(ireq)
7481 ! Send the contacts to processors that need them
7482 do ii=1,ntask_cont_to
7483 iproc=itask_cont_to(ii)
7485 ! write (iout,*) nn," contacts to processor",iproc,
7486 ! & " of CONT_TO_COMM group"
7489 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7490 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7491 ! write (iout,*) "ireq,req",ireq,req(ireq)
7493 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7497 ! write (iout,*) "number of requests (contacts)",ireq
7498 ! write (iout,*) "req",(req(i),i=1,4)
7501 call MPI_Waitall(ireq,req,status_array,ierr)
7502 do iii=1,ntask_cont_from
7503 iproc=itask_cont_from(iii)
7506 write (iout,*) "Received",nn," contacts from processor",iproc,&
7507 " of CONT_FROM_COMM group"
7510 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7515 ii=zapas_recv(1,i,iii)
7516 ! Flag the received contacts to prevent double-counting
7517 jj=-zapas_recv(2,i,iii)
7518 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7520 nnn=num_cont_hb(ii)+1
7523 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7527 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7532 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7540 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7549 write (iout,'(a)') 'Contact function values after receive:'
7551 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7552 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7553 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7560 write (iout,'(a)') 'Contact function values:'
7562 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7563 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7564 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7571 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7572 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7573 ! Remove the loop below after debugging !!!
7580 ! Calculate the dipole-dipole interaction energies
7581 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7582 do i=iatel_s,iatel_e+1
7583 num_conti=num_cont_hb(i)
7592 ! Calculate the local-electrostatic correlation terms
7593 ! write (iout,*) "gradcorr5 in eello5 before loop"
7595 ! write (iout,'(i5,3f10.5)')
7596 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7598 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7599 ! write (iout,*) "corr loop i",i
7601 num_conti=num_cont_hb(i)
7602 num_conti1=num_cont_hb(i+1)
7609 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7610 ! & ' jj=',jj,' kk=',kk
7611 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7612 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7613 .or. j.lt.0 .and. j1.gt.0) .and. &
7614 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7615 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7616 ! The system gains extra energy.
7618 sqd1=dsqrt(d_cont(jj,i))
7619 sqd2=dsqrt(d_cont(kk,i1))
7620 sred_geom = sqd1*sqd2
7621 IF (sred_geom.lt.cutoff_corr) THEN
7622 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7624 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7625 !d & ' jj=',jj,' kk=',kk
7626 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7627 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7629 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7630 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7633 !d write (iout,*) 'sred_geom=',sred_geom,
7634 !d & ' ekont=',ekont,' fprim=',fprimcont,
7635 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7636 !d write (iout,*) "g_contij",g_contij
7637 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7638 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7639 call calc_eello(i,jp,i+1,jp1,jj,kk)
7640 if (wcorr4.gt.0.0d0) &
7641 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7642 if (energy_dec.and.wcorr4.gt.0.0d0) &
7643 write (iout,'(a6,4i5,0pf7.3)') &
7644 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7645 ! write (iout,*) "gradcorr5 before eello5"
7647 ! write (iout,'(i5,3f10.5)')
7648 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7650 if (wcorr5.gt.0.0d0) &
7651 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7652 ! write (iout,*) "gradcorr5 after eello5"
7654 ! write (iout,'(i5,3f10.5)')
7655 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7657 if (energy_dec.and.wcorr5.gt.0.0d0) &
7658 write (iout,'(a6,4i5,0pf7.3)') &
7659 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7660 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7661 !d write(2,*)'ijkl',i,jp,i+1,jp1
7662 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7663 .or. wturn6.eq.0.0d0))then
7664 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7665 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7666 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7667 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7668 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7669 !d & 'ecorr6=',ecorr6
7670 !d write (iout,'(4e15.5)') sred_geom,
7671 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7672 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7673 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7674 else if (wturn6.gt.0.0d0 &
7675 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7676 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7677 eturn6=eturn6+eello_turn6(i,jj,kk)
7678 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7679 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7680 !d write (2,*) 'multibody_eello:eturn6',eturn6
7689 num_cont_hb(i)=num_cont_hb_old(i)
7691 ! write (iout,*) "gradcorr5 in eello5"
7693 ! write (iout,'(i5,3f10.5)')
7694 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7697 end subroutine multibody_eello
7698 !-----------------------------------------------------------------------------
7699 subroutine add_hb_contact_eello(ii,jj,itask)
7700 ! implicit real*8 (a-h,o-z)
7701 ! include "DIMENSIONS"
7702 ! include "COMMON.IOUNITS"
7703 ! include "COMMON.CONTACTS"
7704 ! integer,parameter :: maxconts=nres/4
7705 integer,parameter :: max_dim=70
7706 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7707 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7708 ! common /przechowalnia/ zapas
7710 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7711 integer,dimension(4) ::itask
7712 ! write (iout,*) "itask",itask
7715 if (iproc.gt.0) then
7716 do j=1,num_cont_hb(ii)
7718 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7720 ncont_sent(iproc)=ncont_sent(iproc)+1
7721 nn=ncont_sent(iproc)
7722 zapas(1,nn,iproc)=ii
7723 zapas(2,nn,iproc)=jjc
7724 zapas(3,nn,iproc)=d_cont(j,ii)
7728 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7733 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7741 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7752 end subroutine add_hb_contact_eello
7753 !-----------------------------------------------------------------------------
7754 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7755 ! implicit real*8 (a-h,o-z)
7756 ! include 'DIMENSIONS'
7757 ! include 'COMMON.IOUNITS'
7758 ! include 'COMMON.DERIV'
7759 ! include 'COMMON.INTERACT'
7760 ! include 'COMMON.CONTACTS'
7761 real(kind=8),dimension(3) :: gx,gx1
7764 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7765 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7766 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7767 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
7778 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7779 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7780 ! Following 4 lines for diagnostics.
7785 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7786 ! & 'Contacts ',i,j,
7787 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7788 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7790 ! Calculate the multi-body contribution to energy.
7791 ! ecorr=ecorr+ekont*ees
7792 ! Calculate multi-body contributions to the gradient.
7793 coeffpees0pij=coeffp*ees0pij
7794 coeffmees0mij=coeffm*ees0mij
7795 coeffpees0pkl=coeffp*ees0pkl
7796 coeffmees0mkl=coeffm*ees0mkl
7798 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7799 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7800 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7801 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7802 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7803 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7804 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7805 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7806 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7807 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7808 coeffmees0mij*gacontm_hb1(ll,kk,k))
7809 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7810 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7811 coeffmees0mij*gacontm_hb2(ll,kk,k))
7812 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7813 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7814 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7815 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7816 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7817 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7818 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7819 coeffmees0mij*gacontm_hb3(ll,kk,k))
7820 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7821 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7822 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7827 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7828 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7829 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7830 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7835 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7836 !grad & ees*eij*gacont_hbr(ll,kk,k)-
7837 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7838 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7841 ! write (iout,*) "ehbcorr",ekont*ees
7843 if (shield_mode.gt.0) then
7846 !C print *,i,j,fac_shield(i),fac_shield(j),
7847 !C &fac_shield(k),fac_shield(l)
7848 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
7849 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7850 do ilist=1,ishield_list(i)
7851 iresshield=shield_list(ilist,i)
7853 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7854 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7856 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7857 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7861 do ilist=1,ishield_list(j)
7862 iresshield=shield_list(ilist,j)
7864 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7865 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7867 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7868 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7873 do ilist=1,ishield_list(k)
7874 iresshield=shield_list(ilist,k)
7876 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7877 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7879 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7880 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7884 do ilist=1,ishield_list(l)
7885 iresshield=shield_list(ilist,l)
7887 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
7888 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7890 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
7891 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7896 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
7897 grad_shield(m,i)*ehbcorr/fac_shield(i)
7898 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
7899 grad_shield(m,j)*ehbcorr/fac_shield(j)
7900 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
7901 grad_shield(m,i)*ehbcorr/fac_shield(i)
7902 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
7903 grad_shield(m,j)*ehbcorr/fac_shield(j)
7905 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
7906 grad_shield(m,k)*ehbcorr/fac_shield(k)
7907 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
7908 grad_shield(m,l)*ehbcorr/fac_shield(l)
7909 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
7910 grad_shield(m,k)*ehbcorr/fac_shield(k)
7911 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
7912 grad_shield(m,l)*ehbcorr/fac_shield(l)
7918 end function ehbcorr
7920 !-----------------------------------------------------------------------------
7921 subroutine dipole(i,j,jj)
7922 ! implicit real*8 (a-h,o-z)
7923 ! include 'DIMENSIONS'
7924 ! include 'COMMON.IOUNITS'
7925 ! include 'COMMON.CHAIN'
7926 ! include 'COMMON.FFIELD'
7927 ! include 'COMMON.DERIV'
7928 ! include 'COMMON.INTERACT'
7929 ! include 'COMMON.CONTACTS'
7930 ! include 'COMMON.TORSION'
7931 ! include 'COMMON.VAR'
7932 ! include 'COMMON.GEO'
7933 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
7934 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
7935 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
7937 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
7938 allocate(dipderx(3,5,4,maxconts,nres))
7941 iti1 = itortyp(itype(i+1,1))
7942 if (j.lt.nres-1) then
7943 itj1 = itortyp(itype(j+1,1))
7948 dipi(iii,1)=Ub2(iii,i)
7949 dipderi(iii)=Ub2der(iii,i)
7950 dipi(iii,2)=b1(iii,iti1)
7951 dipj(iii,1)=Ub2(iii,j)
7952 dipderj(iii)=Ub2der(iii,j)
7953 dipj(iii,2)=b1(iii,itj1)
7957 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7960 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7967 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
7971 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7976 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7977 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7979 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7981 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7983 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7986 end subroutine dipole
7988 !-----------------------------------------------------------------------------
7989 subroutine calc_eello(i,j,k,l,jj,kk)
7991 ! This subroutine computes matrices and vectors needed to calculate
7992 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
7995 ! implicit real*8 (a-h,o-z)
7996 ! include 'DIMENSIONS'
7997 ! include 'COMMON.IOUNITS'
7998 ! include 'COMMON.CHAIN'
7999 ! include 'COMMON.DERIV'
8000 ! include 'COMMON.INTERACT'
8001 ! include 'COMMON.CONTACTS'
8002 ! include 'COMMON.TORSION'
8003 ! include 'COMMON.VAR'
8004 ! include 'COMMON.GEO'
8005 ! include 'COMMON.FFIELD'
8006 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8007 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8008 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8011 !el common /kutas/ lprn
8012 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8013 !d & ' jj=',jj,' kk=',kk
8014 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8015 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8016 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8019 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8020 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8023 call transpose2(aa1(1,1),aa1t(1,1))
8024 call transpose2(aa2(1,1),aa2t(1,1))
8027 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8028 aa1tder(1,1,lll,kkk))
8029 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8030 aa2tder(1,1,lll,kkk))
8034 ! parallel orientation of the two CA-CA-CA frames.
8036 iti=itortyp(itype(i,1))
8040 itk1=itortyp(itype(k+1,1))
8041 itj=itortyp(itype(j,1))
8042 if (l.lt.nres-1) then
8043 itl1=itortyp(itype(l+1,1))
8047 ! A1 kernel(j+1) A2T
8049 !d write (iout,'(3f10.5,5x,3f10.5)')
8050 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8052 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8053 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8054 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8055 ! Following matrices are needed only for 6-th order cumulants
8056 IF (wcorr6.gt.0.0d0) THEN
8057 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8058 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8059 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8060 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8061 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8062 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8063 ADtEAderx(1,1,1,1,1,1))
8065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8066 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8067 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8068 ADtEA1derx(1,1,1,1,1,1))
8070 ! End 6-th order cumulants
8073 !d write (2,*) 'In calc_eello6'
8075 !d write (2,*) 'iii=',iii
8077 !d write (2,*) 'kkk=',kkk
8079 !d write (2,'(3(2f10.5),5x)')
8080 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8085 call transpose2(EUgder(1,1,k),auxmat(1,1))
8086 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8087 call transpose2(EUg(1,1,k),auxmat(1,1))
8088 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8089 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8093 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8094 EAEAderx(1,1,lll,kkk,iii,1))
8098 ! A1T kernel(i+1) A2
8099 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8100 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8101 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8102 ! Following matrices are needed only for 6-th order cumulants
8103 IF (wcorr6.gt.0.0d0) THEN
8104 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8105 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8106 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8107 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8108 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8109 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8110 ADtEAderx(1,1,1,1,1,2))
8111 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8112 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8113 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8114 ADtEA1derx(1,1,1,1,1,2))
8116 ! End 6-th order cumulants
8117 call transpose2(EUgder(1,1,l),auxmat(1,1))
8118 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8119 call transpose2(EUg(1,1,l),auxmat(1,1))
8120 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8121 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8125 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8126 EAEAderx(1,1,lll,kkk,iii,2))
8131 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8132 ! They are needed only when the fifth- or the sixth-order cumulants are
8134 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8135 call transpose2(AEA(1,1,1),auxmat(1,1))
8136 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8137 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8138 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8139 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8140 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8141 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8142 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8143 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8144 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8145 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8146 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8147 call transpose2(AEA(1,1,2),auxmat(1,1))
8148 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8149 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8150 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8151 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8152 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8153 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8154 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8155 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8156 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8157 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8158 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8159 ! Calculate the Cartesian derivatives of the vectors.
8163 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8164 call matvec2(auxmat(1,1),b1(1,iti),&
8165 AEAb1derx(1,lll,kkk,iii,1,1))
8166 call matvec2(auxmat(1,1),Ub2(1,i),&
8167 AEAb2derx(1,lll,kkk,iii,1,1))
8168 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8169 AEAb1derx(1,lll,kkk,iii,2,1))
8170 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8171 AEAb2derx(1,lll,kkk,iii,2,1))
8172 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8173 call matvec2(auxmat(1,1),b1(1,itj),&
8174 AEAb1derx(1,lll,kkk,iii,1,2))
8175 call matvec2(auxmat(1,1),Ub2(1,j),&
8176 AEAb2derx(1,lll,kkk,iii,1,2))
8177 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8178 AEAb1derx(1,lll,kkk,iii,2,2))
8179 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8180 AEAb2derx(1,lll,kkk,iii,2,2))
8187 ! Antiparallel orientation of the two CA-CA-CA frames.
8189 iti=itortyp(itype(i,1))
8193 itk1=itortyp(itype(k+1,1))
8194 itl=itortyp(itype(l,1))
8195 itj=itortyp(itype(j,1))
8196 if (j.lt.nres-1) then
8197 itj1=itortyp(itype(j+1,1))
8201 ! A2 kernel(j-1)T A1T
8202 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8203 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8204 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8205 ! Following matrices are needed only for 6-th order cumulants
8206 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8207 j.eq.i+4 .and. l.eq.i+3)) THEN
8208 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8209 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8210 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8211 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8212 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8213 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8214 ADtEAderx(1,1,1,1,1,1))
8215 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8216 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8217 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8218 ADtEA1derx(1,1,1,1,1,1))
8220 ! End 6-th order cumulants
8221 call transpose2(EUgder(1,1,k),auxmat(1,1))
8222 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8223 call transpose2(EUg(1,1,k),auxmat(1,1))
8224 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8225 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8229 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8230 EAEAderx(1,1,lll,kkk,iii,1))
8234 ! A2T kernel(i+1)T A1
8235 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8236 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8237 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8238 ! Following matrices are needed only for 6-th order cumulants
8239 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8240 j.eq.i+4 .and. l.eq.i+3)) THEN
8241 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8242 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8243 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8244 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8245 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8246 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8247 ADtEAderx(1,1,1,1,1,2))
8248 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8249 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8250 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8251 ADtEA1derx(1,1,1,1,1,2))
8253 ! End 6-th order cumulants
8254 call transpose2(EUgder(1,1,j),auxmat(1,1))
8255 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8256 call transpose2(EUg(1,1,j),auxmat(1,1))
8257 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8258 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8262 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8263 EAEAderx(1,1,lll,kkk,iii,2))
8268 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8269 ! They are needed only when the fifth- or the sixth-order cumulants are
8271 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8272 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8273 call transpose2(AEA(1,1,1),auxmat(1,1))
8274 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8275 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8276 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8277 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8278 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8279 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8280 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8281 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8282 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8283 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8284 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8285 call transpose2(AEA(1,1,2),auxmat(1,1))
8286 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8287 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8288 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8289 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8290 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8291 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8292 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8293 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8294 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8295 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8296 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8297 ! Calculate the Cartesian derivatives of the vectors.
8301 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8302 call matvec2(auxmat(1,1),b1(1,iti),&
8303 AEAb1derx(1,lll,kkk,iii,1,1))
8304 call matvec2(auxmat(1,1),Ub2(1,i),&
8305 AEAb2derx(1,lll,kkk,iii,1,1))
8306 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8307 AEAb1derx(1,lll,kkk,iii,2,1))
8308 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8309 AEAb2derx(1,lll,kkk,iii,2,1))
8310 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8311 call matvec2(auxmat(1,1),b1(1,itl),&
8312 AEAb1derx(1,lll,kkk,iii,1,2))
8313 call matvec2(auxmat(1,1),Ub2(1,l),&
8314 AEAb2derx(1,lll,kkk,iii,1,2))
8315 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8316 AEAb1derx(1,lll,kkk,iii,2,2))
8317 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8318 AEAb2derx(1,lll,kkk,iii,2,2))
8326 end subroutine calc_eello
8327 !-----------------------------------------------------------------------------
8328 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8333 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8334 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8335 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8336 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8337 integer :: iii,kkk,lll
8340 !el common /kutas/ lprn
8341 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8343 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8346 !d if (lprn) write (2,*) 'In kernel'
8348 !d if (lprn) write (2,*) 'kkk=',kkk
8350 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8351 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8353 !d write (2,*) 'lll=',lll
8354 !d write (2,*) 'iii=1'
8356 !d write (2,'(3(2f10.5),5x)')
8357 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8360 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8361 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8363 !d write (2,*) 'lll=',lll
8364 !d write (2,*) 'iii=2'
8366 !d write (2,'(3(2f10.5),5x)')
8367 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8373 end subroutine kernel
8374 !-----------------------------------------------------------------------------
8375 real(kind=8) function eello4(i,j,k,l,jj,kk)
8376 ! implicit real*8 (a-h,o-z)
8377 ! include 'DIMENSIONS'
8378 ! include 'COMMON.IOUNITS'
8379 ! include 'COMMON.CHAIN'
8380 ! include 'COMMON.DERIV'
8381 ! include 'COMMON.INTERACT'
8382 ! include 'COMMON.CONTACTS'
8383 ! include 'COMMON.TORSION'
8384 ! include 'COMMON.VAR'
8385 ! include 'COMMON.GEO'
8386 real(kind=8),dimension(2,2) :: pizda
8387 real(kind=8),dimension(3) :: ggg1,ggg2
8388 real(kind=8) :: eel4,glongij,glongkl
8389 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8390 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8394 !d print *,'eello4:',i,j,k,l,jj,kk
8395 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8396 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8397 !old eij=facont_hb(jj,i)
8398 !old ekl=facont_hb(kk,k)
8400 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8401 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8402 gcorr_loc(k-1)=gcorr_loc(k-1) &
8403 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8405 gcorr_loc(l-1)=gcorr_loc(l-1) &
8406 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8408 gcorr_loc(j-1)=gcorr_loc(j-1) &
8409 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8414 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8415 -EAEAderx(2,2,lll,kkk,iii,1)
8416 !d derx(lll,kkk,iii)=0.0d0
8420 !d gcorr_loc(l-1)=0.0d0
8421 !d gcorr_loc(j-1)=0.0d0
8422 !d gcorr_loc(k-1)=0.0d0
8424 !d write (iout,*)'Contacts have occurred for peptide groups',
8425 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8426 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8427 if (j.lt.nres-1) then
8434 if (l.lt.nres-1) then
8442 !grad ggg1(ll)=eel4*g_contij(ll,1)
8443 !grad ggg2(ll)=eel4*g_contij(ll,2)
8444 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8445 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8446 !grad ghalf=0.5d0*ggg1(ll)
8447 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8448 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8449 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8450 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8451 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8452 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8453 !grad ghalf=0.5d0*ggg2(ll)
8454 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8455 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8456 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8457 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8458 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8459 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8463 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8468 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8473 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8478 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8482 !d write (2,*) iii,gcorr_loc(iii)
8485 !d write (2,*) 'ekont',ekont
8486 !d write (iout,*) 'eello4',ekont*eel4
8489 !-----------------------------------------------------------------------------
8490 real(kind=8) function eello5(i,j,k,l,jj,kk)
8491 ! implicit real*8 (a-h,o-z)
8492 ! include 'DIMENSIONS'
8493 ! include 'COMMON.IOUNITS'
8494 ! include 'COMMON.CHAIN'
8495 ! include 'COMMON.DERIV'
8496 ! include 'COMMON.INTERACT'
8497 ! include 'COMMON.CONTACTS'
8498 ! include 'COMMON.TORSION'
8499 ! include 'COMMON.VAR'
8500 ! include 'COMMON.GEO'
8501 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8502 real(kind=8),dimension(2) :: vv
8503 real(kind=8),dimension(3) :: ggg1,ggg2
8504 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8505 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8506 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8507 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8512 ! /l\ / \ \ / \ / \ / C
8513 ! / \ / \ \ / \ / \ / C
8514 ! j| o |l1 | o | o| o | | o |o C
8515 ! \ |/k\| |/ \| / |/ \| |/ \| C
8516 ! \i/ \ / \ / / \ / \ C
8518 ! (I) (II) (III) (IV) C
8520 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8522 ! Antiparallel chains C
8525 ! /j\ / \ \ / \ / \ / C
8526 ! / \ / \ \ / \ / \ / C
8527 ! j1| o |l | o | o| o | | o |o C
8528 ! \ |/k\| |/ \| / |/ \| |/ \| C
8529 ! \i/ \ / \ / / \ / \ C
8531 ! (I) (II) (III) (IV) C
8533 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8535 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8537 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8538 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8543 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8545 itk=itortyp(itype(k,1))
8546 itl=itortyp(itype(l,1))
8547 itj=itortyp(itype(j,1))
8552 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8553 !d & eel5_3_num,eel5_4_num)
8557 derx(lll,kkk,iii)=0.0d0
8561 !d eij=facont_hb(jj,i)
8562 !d ekl=facont_hb(kk,k)
8564 !d write (iout,*)'Contacts have occurred for peptide groups',
8565 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8567 ! Contribution from the graph I.
8568 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8569 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8570 call transpose2(EUg(1,1,k),auxmat(1,1))
8571 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8572 vv(1)=pizda(1,1)-pizda(2,2)
8573 vv(2)=pizda(1,2)+pizda(2,1)
8574 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8575 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8576 ! Explicit gradient in virtual-dihedral angles.
8577 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8578 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8579 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8580 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8581 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8582 vv(1)=pizda(1,1)-pizda(2,2)
8583 vv(2)=pizda(1,2)+pizda(2,1)
8584 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8585 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8586 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8587 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8588 vv(1)=pizda(1,1)-pizda(2,2)
8589 vv(2)=pizda(1,2)+pizda(2,1)
8591 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8592 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8593 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8595 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8596 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8597 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8599 ! Cartesian gradient
8603 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8605 vv(1)=pizda(1,1)-pizda(2,2)
8606 vv(2)=pizda(1,2)+pizda(2,1)
8607 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8608 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8609 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8615 ! Contribution from graph II
8616 call transpose2(EE(1,1,itk),auxmat(1,1))
8617 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8618 vv(1)=pizda(1,1)+pizda(2,2)
8619 vv(2)=pizda(2,1)-pizda(1,2)
8620 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8621 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8622 ! Explicit gradient in virtual-dihedral angles.
8623 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8624 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8625 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8626 vv(1)=pizda(1,1)+pizda(2,2)
8627 vv(2)=pizda(2,1)-pizda(1,2)
8629 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8630 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8631 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8633 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8634 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8635 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8637 ! Cartesian gradient
8641 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8643 vv(1)=pizda(1,1)+pizda(2,2)
8644 vv(2)=pizda(2,1)-pizda(1,2)
8645 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8646 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8647 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8655 ! Parallel orientation
8656 ! Contribution from graph III
8657 call transpose2(EUg(1,1,l),auxmat(1,1))
8658 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8659 vv(1)=pizda(1,1)-pizda(2,2)
8660 vv(2)=pizda(1,2)+pizda(2,1)
8661 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8662 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8663 ! Explicit gradient in virtual-dihedral angles.
8664 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8665 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8666 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8667 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8668 vv(1)=pizda(1,1)-pizda(2,2)
8669 vv(2)=pizda(1,2)+pizda(2,1)
8670 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8671 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8672 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8673 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8674 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8675 vv(1)=pizda(1,1)-pizda(2,2)
8676 vv(2)=pizda(1,2)+pizda(2,1)
8677 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8678 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8679 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8680 ! Cartesian gradient
8684 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8686 vv(1)=pizda(1,1)-pizda(2,2)
8687 vv(2)=pizda(1,2)+pizda(2,1)
8688 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8689 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8690 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8695 ! Contribution from graph IV
8697 call transpose2(EE(1,1,itl),auxmat(1,1))
8698 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8699 vv(1)=pizda(1,1)+pizda(2,2)
8700 vv(2)=pizda(2,1)-pizda(1,2)
8701 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8702 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8703 ! Explicit gradient in virtual-dihedral angles.
8704 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8705 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8706 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8707 vv(1)=pizda(1,1)+pizda(2,2)
8708 vv(2)=pizda(2,1)-pizda(1,2)
8709 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8710 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8711 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8712 ! Cartesian gradient
8716 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8718 vv(1)=pizda(1,1)+pizda(2,2)
8719 vv(2)=pizda(2,1)-pizda(1,2)
8720 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8721 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8722 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8727 ! Antiparallel orientation
8728 ! Contribution from graph III
8730 call transpose2(EUg(1,1,j),auxmat(1,1))
8731 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8732 vv(1)=pizda(1,1)-pizda(2,2)
8733 vv(2)=pizda(1,2)+pizda(2,1)
8734 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8735 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8736 ! Explicit gradient in virtual-dihedral angles.
8737 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8738 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8739 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8740 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8741 vv(1)=pizda(1,1)-pizda(2,2)
8742 vv(2)=pizda(1,2)+pizda(2,1)
8743 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8744 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8745 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8746 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8747 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8748 vv(1)=pizda(1,1)-pizda(2,2)
8749 vv(2)=pizda(1,2)+pizda(2,1)
8750 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8751 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8752 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8753 ! Cartesian gradient
8757 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8759 vv(1)=pizda(1,1)-pizda(2,2)
8760 vv(2)=pizda(1,2)+pizda(2,1)
8761 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8762 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8763 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8768 ! Contribution from graph IV
8770 call transpose2(EE(1,1,itj),auxmat(1,1))
8771 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8772 vv(1)=pizda(1,1)+pizda(2,2)
8773 vv(2)=pizda(2,1)-pizda(1,2)
8774 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
8775 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8776 ! Explicit gradient in virtual-dihedral angles.
8777 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8778 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8779 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8780 vv(1)=pizda(1,1)+pizda(2,2)
8781 vv(2)=pizda(2,1)-pizda(1,2)
8782 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8783 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
8784 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8785 ! Cartesian gradient
8789 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8791 vv(1)=pizda(1,1)+pizda(2,2)
8792 vv(2)=pizda(2,1)-pizda(1,2)
8793 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8794 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
8795 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8801 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8802 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8803 !d write (2,*) 'ijkl',i,j,k,l
8804 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8805 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
8807 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8808 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8809 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8810 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8811 if (j.lt.nres-1) then
8818 if (l.lt.nres-1) then
8828 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8829 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
8830 ! summed up outside the subrouine as for the other subroutines
8831 ! handling long-range interactions. The old code is commented out
8832 ! with "cgrad" to keep track of changes.
8834 !grad ggg1(ll)=eel5*g_contij(ll,1)
8835 !grad ggg2(ll)=eel5*g_contij(ll,2)
8836 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8837 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8838 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8839 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8840 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8841 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8842 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8843 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8845 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8846 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8847 !grad ghalf=0.5d0*ggg1(ll)
8849 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8850 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8851 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8852 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8853 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8854 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8855 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8856 !grad ghalf=0.5d0*ggg2(ll)
8858 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8859 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8860 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8861 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8862 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8863 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8868 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8869 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8874 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8875 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8881 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8886 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8890 !d write (2,*) iii,g_corr5_loc(iii)
8893 !d write (2,*) 'ekont',ekont
8894 !d write (iout,*) 'eello5',ekont*eel5
8897 !-----------------------------------------------------------------------------
8898 real(kind=8) function eello6(i,j,k,l,jj,kk)
8899 ! implicit real*8 (a-h,o-z)
8900 ! include 'DIMENSIONS'
8901 ! include 'COMMON.IOUNITS'
8902 ! include 'COMMON.CHAIN'
8903 ! include 'COMMON.DERIV'
8904 ! include 'COMMON.INTERACT'
8905 ! include 'COMMON.CONTACTS'
8906 ! include 'COMMON.TORSION'
8907 ! include 'COMMON.VAR'
8908 ! include 'COMMON.GEO'
8909 ! include 'COMMON.FFIELD'
8910 real(kind=8),dimension(3) :: ggg1,ggg2
8911 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
8913 real(kind=8) :: gradcorr6ij,gradcorr6kl
8914 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8915 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8920 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8928 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8929 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8933 derx(lll,kkk,iii)=0.0d0
8937 !d eij=facont_hb(jj,i)
8938 !d ekl=facont_hb(kk,k)
8944 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8945 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8946 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8947 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8948 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8949 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8951 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8952 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8953 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8954 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8955 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8956 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8960 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8962 ! If turn contributions are considered, they will be handled separately.
8963 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8964 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8965 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8966 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8967 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8968 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8969 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8971 if (j.lt.nres-1) then
8978 if (l.lt.nres-1) then
8986 !grad ggg1(ll)=eel6*g_contij(ll,1)
8987 !grad ggg2(ll)=eel6*g_contij(ll,2)
8988 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8989 !grad ghalf=0.5d0*ggg1(ll)
8991 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8992 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8993 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8994 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8995 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8996 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8997 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8998 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8999 !grad ghalf=0.5d0*ggg2(ll)
9000 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9002 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9003 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9004 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9005 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9006 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9007 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9012 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9013 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9018 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9019 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9025 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9030 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9034 !d write (2,*) iii,g_corr6_loc(iii)
9037 !d write (2,*) 'ekont',ekont
9038 !d write (iout,*) 'eello6',ekont*eel6
9041 !-----------------------------------------------------------------------------
9042 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9044 ! implicit real*8 (a-h,o-z)
9045 ! include 'DIMENSIONS'
9046 ! include 'COMMON.IOUNITS'
9047 ! include 'COMMON.CHAIN'
9048 ! include 'COMMON.DERIV'
9049 ! include 'COMMON.INTERACT'
9050 ! include 'COMMON.CONTACTS'
9051 ! include 'COMMON.TORSION'
9052 ! include 'COMMON.VAR'
9053 ! include 'COMMON.GEO'
9054 real(kind=8),dimension(2) :: vv,vv1
9055 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9058 !el common /kutas/ lprn
9059 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9060 real(kind=8) :: s1,s2,s3,s4,s5
9061 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9063 ! Parallel Antiparallel C
9069 ! \ j|/k\| / \ |/k\|l / C
9074 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9075 itk=itortyp(itype(k,1))
9076 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9077 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9078 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9079 call transpose2(EUgC(1,1,k),auxmat(1,1))
9080 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9081 vv1(1)=pizda1(1,1)-pizda1(2,2)
9082 vv1(2)=pizda1(1,2)+pizda1(2,1)
9083 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9084 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9085 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9086 s5=scalar2(vv(1),Dtobr2(1,i))
9087 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9088 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9089 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9090 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9091 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9092 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9093 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9094 +scalar2(vv(1),Dtobr2der(1,i)))
9095 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9096 vv1(1)=pizda1(1,1)-pizda1(2,2)
9097 vv1(2)=pizda1(1,2)+pizda1(2,1)
9098 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9099 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9101 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9102 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9103 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9104 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9105 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9107 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9108 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9109 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9110 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9111 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9113 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9114 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9115 vv1(1)=pizda1(1,1)-pizda1(2,2)
9116 vv1(2)=pizda1(1,2)+pizda1(2,1)
9117 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9118 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9119 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9120 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9129 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9130 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9131 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9132 call transpose2(EUgC(1,1,k),auxmat(1,1))
9133 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9135 vv1(1)=pizda1(1,1)-pizda1(2,2)
9136 vv1(2)=pizda1(1,2)+pizda1(2,1)
9137 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9138 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9139 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9140 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9141 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9142 s5=scalar2(vv(1),Dtobr2(1,i))
9143 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9148 end function eello6_graph1
9149 !-----------------------------------------------------------------------------
9150 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9152 ! implicit real*8 (a-h,o-z)
9153 ! include 'DIMENSIONS'
9154 ! include 'COMMON.IOUNITS'
9155 ! include 'COMMON.CHAIN'
9156 ! include 'COMMON.DERIV'
9157 ! include 'COMMON.INTERACT'
9158 ! include 'COMMON.CONTACTS'
9159 ! include 'COMMON.TORSION'
9160 ! include 'COMMON.VAR'
9161 ! include 'COMMON.GEO'
9163 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9164 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9166 !el common /kutas/ lprn
9167 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9168 real(kind=8) :: s2,s3,s4
9169 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9171 ! Parallel Antiparallel C
9177 ! \ j|/k\| \ |/k\|l C
9182 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9183 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9184 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9185 ! but not in a cluster cumulant
9187 s1=dip(1,jj,i)*dip(1,kk,k)
9189 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9190 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9191 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9192 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9193 call transpose2(EUg(1,1,k),auxmat(1,1))
9194 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9195 vv(1)=pizda(1,1)-pizda(2,2)
9196 vv(2)=pizda(1,2)+pizda(2,1)
9197 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9198 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9200 eello6_graph2=-(s1+s2+s3+s4)
9202 eello6_graph2=-(s2+s3+s4)
9205 ! Derivatives in gamma(i-1)
9208 s1=dipderg(1,jj,i)*dip(1,kk,k)
9210 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9211 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9212 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9213 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9215 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9217 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9219 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9221 ! Derivatives in gamma(k-1)
9223 s1=dip(1,jj,i)*dipderg(1,kk,k)
9225 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9226 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9227 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9228 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9229 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9230 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9231 vv(1)=pizda(1,1)-pizda(2,2)
9232 vv(2)=pizda(1,2)+pizda(2,1)
9233 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9235 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9237 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9239 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9240 ! Derivatives in gamma(j-1) or gamma(l-1)
9243 s1=dipderg(3,jj,i)*dip(1,kk,k)
9245 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9246 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9247 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9248 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9249 vv(1)=pizda(1,1)-pizda(2,2)
9250 vv(2)=pizda(1,2)+pizda(2,1)
9251 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9254 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9256 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9259 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9260 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9262 ! Derivatives in gamma(l-1) or gamma(j-1)
9265 s1=dip(1,jj,i)*dipderg(3,kk,k)
9267 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9268 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9269 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9270 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9271 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9272 vv(1)=pizda(1,1)-pizda(2,2)
9273 vv(2)=pizda(1,2)+pizda(2,1)
9274 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9277 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9279 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9282 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9283 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9285 ! Cartesian derivatives.
9287 write (2,*) 'In eello6_graph2'
9289 write (2,*) 'iii=',iii
9291 write (2,*) 'kkk=',kkk
9293 write (2,'(3(2f10.5),5x)') &
9294 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9304 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9306 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9309 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9311 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9312 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9314 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9315 call transpose2(EUg(1,1,k),auxmat(1,1))
9316 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9318 vv(1)=pizda(1,1)-pizda(2,2)
9319 vv(2)=pizda(1,2)+pizda(2,1)
9320 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9321 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9323 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9325 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9328 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9330 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9336 end function eello6_graph2
9337 !-----------------------------------------------------------------------------
9338 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9339 ! implicit real*8 (a-h,o-z)
9340 ! include 'DIMENSIONS'
9341 ! include 'COMMON.IOUNITS'
9342 ! include 'COMMON.CHAIN'
9343 ! include 'COMMON.DERIV'
9344 ! include 'COMMON.INTERACT'
9345 ! include 'COMMON.CONTACTS'
9346 ! include 'COMMON.TORSION'
9347 ! include 'COMMON.VAR'
9348 ! include 'COMMON.GEO'
9349 real(kind=8),dimension(2) :: vv,auxvec
9350 real(kind=8),dimension(2,2) :: pizda,auxmat
9352 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9353 real(kind=8) :: s1,s2,s3,s4
9354 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9356 ! Parallel Antiparallel C
9362 ! j|/k\| / |/k\|l / C
9367 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9369 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9370 ! energy moment and not to the cluster cumulant.
9371 iti=itortyp(itype(i,1))
9372 if (j.lt.nres-1) then
9373 itj1=itortyp(itype(j+1,1))
9377 itk=itortyp(itype(k,1))
9378 itk1=itortyp(itype(k+1,1))
9379 if (l.lt.nres-1) then
9380 itl1=itortyp(itype(l+1,1))
9385 s1=dip(4,jj,i)*dip(4,kk,k)
9387 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9388 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9389 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9390 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9391 call transpose2(EE(1,1,itk),auxmat(1,1))
9392 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9393 vv(1)=pizda(1,1)+pizda(2,2)
9394 vv(2)=pizda(2,1)-pizda(1,2)
9395 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9396 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9397 !d & "sum",-(s2+s3+s4)
9399 eello6_graph3=-(s1+s2+s3+s4)
9401 eello6_graph3=-(s2+s3+s4)
9404 ! Derivatives in gamma(k-1)
9405 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9406 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9407 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9408 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9409 ! Derivatives in gamma(l-1)
9410 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9411 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9412 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9413 vv(1)=pizda(1,1)+pizda(2,2)
9414 vv(2)=pizda(2,1)-pizda(1,2)
9415 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9416 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9417 ! Cartesian derivatives.
9423 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9425 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9428 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9430 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9431 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9433 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9434 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9436 vv(1)=pizda(1,1)+pizda(2,2)
9437 vv(2)=pizda(2,1)-pizda(1,2)
9438 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9440 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9442 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9445 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9447 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9449 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9454 end function eello6_graph3
9455 !-----------------------------------------------------------------------------
9456 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9457 ! implicit real*8 (a-h,o-z)
9458 ! include 'DIMENSIONS'
9459 ! include 'COMMON.IOUNITS'
9460 ! include 'COMMON.CHAIN'
9461 ! include 'COMMON.DERIV'
9462 ! include 'COMMON.INTERACT'
9463 ! include 'COMMON.CONTACTS'
9464 ! include 'COMMON.TORSION'
9465 ! include 'COMMON.VAR'
9466 ! include 'COMMON.GEO'
9467 ! include 'COMMON.FFIELD'
9468 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9469 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9471 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9473 real(kind=8) :: s1,s2,s3,s4
9474 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9476 ! Parallel Antiparallel C
9482 ! \ j|/k\| \ |/k\|l C
9487 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9489 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9490 ! energy moment and not to the cluster cumulant.
9491 !d write (2,*) 'eello_graph4: wturn6',wturn6
9492 iti=itortyp(itype(i,1))
9493 itj=itortyp(itype(j,1))
9494 if (j.lt.nres-1) then
9495 itj1=itortyp(itype(j+1,1))
9499 itk=itortyp(itype(k,1))
9500 if (k.lt.nres-1) then
9501 itk1=itortyp(itype(k+1,1))
9505 itl=itortyp(itype(l,1))
9506 if (l.lt.nres-1) then
9507 itl1=itortyp(itype(l+1,1))
9511 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9512 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9513 !d & ' itl',itl,' itl1',itl1
9516 s1=dip(3,jj,i)*dip(3,kk,k)
9518 s1=dip(2,jj,j)*dip(2,kk,l)
9521 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9522 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9524 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9525 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9527 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9528 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9530 call transpose2(EUg(1,1,k),auxmat(1,1))
9531 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9532 vv(1)=pizda(1,1)-pizda(2,2)
9533 vv(2)=pizda(2,1)+pizda(1,2)
9534 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9535 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9537 eello6_graph4=-(s1+s2+s3+s4)
9539 eello6_graph4=-(s2+s3+s4)
9541 ! Derivatives in gamma(i-1)
9545 s1=dipderg(2,jj,i)*dip(3,kk,k)
9547 s1=dipderg(4,jj,j)*dip(2,kk,l)
9550 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9552 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9553 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9555 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9556 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9558 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9559 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9560 !d write (2,*) 'turn6 derivatives'
9562 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9564 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9568 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9570 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9574 ! Derivatives in gamma(k-1)
9577 s1=dip(3,jj,i)*dipderg(2,kk,k)
9579 s1=dip(2,jj,j)*dipderg(4,kk,l)
9582 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9583 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9585 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9586 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9588 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9589 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9591 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9592 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9593 vv(1)=pizda(1,1)-pizda(2,2)
9594 vv(2)=pizda(2,1)+pizda(1,2)
9595 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9596 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9598 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9600 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9604 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9606 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9609 ! Derivatives in gamma(j-1) or gamma(l-1)
9610 if (l.eq.j+1 .and. l.gt.1) then
9611 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9612 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9613 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9614 vv(1)=pizda(1,1)-pizda(2,2)
9615 vv(2)=pizda(2,1)+pizda(1,2)
9616 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9617 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9618 else if (j.gt.1) then
9619 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9620 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9621 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9622 vv(1)=pizda(1,1)-pizda(2,2)
9623 vv(2)=pizda(2,1)+pizda(1,2)
9624 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9625 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9626 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9628 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9631 ! Cartesian derivatives.
9638 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9640 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9644 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9646 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9650 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9652 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9654 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9655 b1(1,itj1),auxvec(1))
9656 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9658 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9659 b1(1,itl1),auxvec(1))
9660 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9662 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9664 vv(1)=pizda(1,1)-pizda(2,2)
9665 vv(2)=pizda(2,1)+pizda(1,2)
9666 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9668 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9670 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9673 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9676 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9679 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9681 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9683 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9687 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9689 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9692 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9694 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9701 end function eello6_graph4
9702 !-----------------------------------------------------------------------------
9703 real(kind=8) function eello_turn6(i,jj,kk)
9704 ! implicit real*8 (a-h,o-z)
9705 ! include 'DIMENSIONS'
9706 ! include 'COMMON.IOUNITS'
9707 ! include 'COMMON.CHAIN'
9708 ! include 'COMMON.DERIV'
9709 ! include 'COMMON.INTERACT'
9710 ! include 'COMMON.CONTACTS'
9711 ! include 'COMMON.TORSION'
9712 ! include 'COMMON.VAR'
9713 ! include 'COMMON.GEO'
9714 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9715 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9716 real(kind=8),dimension(3) :: ggg1,ggg2
9717 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9718 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9719 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9720 ! the respective energy moment and not to the cluster cumulant.
9722 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9723 integer :: j1,j2,l1,l2,ll
9724 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9725 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9734 iti=itortyp(itype(i,1))
9735 itk=itortyp(itype(k,1))
9736 itk1=itortyp(itype(k+1,1))
9737 itl=itortyp(itype(l,1))
9738 itj=itortyp(itype(j,1))
9739 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9740 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9741 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9746 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9748 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9752 derx_turn(lll,kkk,iii)=0.0d0
9759 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9761 !d write (2,*) 'eello6_5',eello6_5
9763 call transpose2(AEA(1,1,1),auxmat(1,1))
9764 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9765 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9766 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9768 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9769 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9770 s2 = scalar2(b1(1,itk),vtemp1(1))
9772 call transpose2(AEA(1,1,2),atemp(1,1))
9773 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9774 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9775 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9777 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9778 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9779 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9781 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9782 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9783 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9784 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9785 ss13 = scalar2(b1(1,itk),vtemp4(1))
9786 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9788 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9794 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9795 ! Derivatives in gamma(i+2)
9799 call transpose2(AEA(1,1,1),auxmatd(1,1))
9800 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9801 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9802 call transpose2(AEAderg(1,1,2),atempd(1,1))
9803 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9804 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9806 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9807 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9808 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9814 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9815 ! Derivatives in gamma(i+3)
9817 call transpose2(AEA(1,1,1),auxmatd(1,1))
9818 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9819 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9820 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9822 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9823 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9824 s2d = scalar2(b1(1,itk),vtemp1d(1))
9826 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9827 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9829 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9831 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9832 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9833 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9841 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9842 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9844 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9845 -0.5d0*ekont*(s2d+s12d)
9847 ! Derivatives in gamma(i+4)
9848 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9849 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9850 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9852 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9853 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9854 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9862 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9864 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9866 ! Derivatives in gamma(i+5)
9868 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9869 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9870 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9872 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9873 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9874 s2d = scalar2(b1(1,itk),vtemp1d(1))
9876 call transpose2(AEA(1,1,2),atempd(1,1))
9877 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9878 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9880 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9881 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9883 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9884 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9885 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9893 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9894 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9896 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
9897 -0.5d0*ekont*(s2d+s12d)
9899 ! Cartesian derivatives
9904 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9905 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9906 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9908 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9909 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
9911 s2d = scalar2(b1(1,itk),vtemp1d(1))
9913 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9914 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9915 s8d = -(atempd(1,1)+atempd(2,2))* &
9916 scalar2(cc(1,1,itl),vtemp2(1))
9918 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
9920 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9921 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9928 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9931 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
9935 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9938 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
9947 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
9949 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9950 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9951 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9952 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9953 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
9955 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9956 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9957 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9961 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9962 !d & 16*eel_turn6_num
9964 if (j.lt.nres-1) then
9971 if (l.lt.nres-1) then
9979 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
9980 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
9981 !grad ghalf=0.5d0*ggg1(ll)
9983 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9984 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9985 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
9986 +ekont*derx_turn(ll,2,1)
9987 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9988 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
9989 +ekont*derx_turn(ll,4,1)
9990 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9991 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9992 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9993 !grad ghalf=0.5d0*ggg2(ll)
9995 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
9996 +ekont*derx_turn(ll,2,2)
9997 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9998 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
9999 +ekont*derx_turn(ll,4,2)
10000 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10001 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10002 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10007 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10012 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10018 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10023 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10027 !d write (2,*) iii,g_corr6_loc(iii)
10029 eello_turn6=ekont*eel_turn6
10030 !d write (2,*) 'ekont',ekont
10031 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10033 end function eello_turn6
10034 !-----------------------------------------------------------------------------
10035 subroutine MATVEC2(A1,V1,V2)
10036 !DIR$ INLINEALWAYS MATVEC2
10038 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10040 ! implicit real*8 (a-h,o-z)
10041 ! include 'DIMENSIONS'
10042 real(kind=8),dimension(2) :: V1,V2
10043 real(kind=8),dimension(2,2) :: A1
10044 real(kind=8) :: vaux1,vaux2
10048 ! 3 VI=VI+A1(I,K)*V1(K)
10052 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10053 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10057 end subroutine MATVEC2
10058 !-----------------------------------------------------------------------------
10059 subroutine MATMAT2(A1,A2,A3)
10061 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10063 ! implicit real*8 (a-h,o-z)
10064 ! include 'DIMENSIONS'
10065 real(kind=8),dimension(2,2) :: A1,A2,A3
10066 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10067 ! DIMENSION AI3(2,2)
10071 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10077 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10078 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10079 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10080 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10086 end subroutine MATMAT2
10087 !-----------------------------------------------------------------------------
10088 real(kind=8) function scalar2(u,v)
10089 !DIR$ INLINEALWAYS scalar2
10091 real(kind=8),dimension(2) :: u,v
10094 scalar2=u(1)*v(1)+u(2)*v(2)
10096 end function scalar2
10097 !-----------------------------------------------------------------------------
10098 subroutine transpose2(a,at)
10099 !DIR$ INLINEALWAYS transpose2
10101 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10104 real(kind=8),dimension(2,2) :: a,at
10110 end subroutine transpose2
10111 !-----------------------------------------------------------------------------
10112 subroutine transpose(n,a,at)
10115 real(kind=8),dimension(n,n) :: a,at
10122 end subroutine transpose
10123 !-----------------------------------------------------------------------------
10124 subroutine prodmat3(a1,a2,kk,transp,prod)
10125 !DIR$ INLINEALWAYS prodmat3
10127 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10131 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10133 !rc double precision auxmat(2,2),prod_(2,2)
10136 !rc call transpose2(kk(1,1),auxmat(1,1))
10137 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10138 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10140 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10141 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10142 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10143 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10144 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10145 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10146 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10147 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10150 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10151 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10153 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10154 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10155 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10156 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10157 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10158 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10159 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10160 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10163 ! call transpose2(a2(1,1),a2t(1,1))
10166 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10167 !rc print *,((prod(i,j),i=1,2),j=1,2)
10170 end subroutine prodmat3
10171 !-----------------------------------------------------------------------------
10172 ! energy_p_new_barrier.F
10173 !-----------------------------------------------------------------------------
10174 subroutine sum_gradient
10175 ! implicit real*8 (a-h,o-z)
10176 use io_base, only: pdbout
10177 ! include 'DIMENSIONS'
10181 !MS$ATTRIBUTES C :: proc_proc
10187 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10188 gloc_scbuf !(3,maxres)
10190 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10192 !el local variables
10193 integer :: i,j,k,ierror,ierr
10194 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10195 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10196 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10197 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10198 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10199 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10200 gsccorr_max,gsccorrx_max,time00
10202 ! include 'COMMON.SETUP'
10203 ! include 'COMMON.IOUNITS'
10204 ! include 'COMMON.FFIELD'
10205 ! include 'COMMON.DERIV'
10206 ! include 'COMMON.INTERACT'
10207 ! include 'COMMON.SBRIDGE'
10208 ! include 'COMMON.CHAIN'
10209 ! include 'COMMON.VAR'
10210 ! include 'COMMON.CONTROL'
10211 ! include 'COMMON.TIME1'
10212 ! include 'COMMON.MAXGRAD'
10213 ! include 'COMMON.SCCOR'
10218 write (iout,*) "sum_gradient gvdwc, gvdwx"
10220 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10221 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10231 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10232 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10233 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10236 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10237 ! in virtual-bond-vector coordinates
10240 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10242 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10243 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10245 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10247 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10248 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10250 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10252 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10253 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10254 (gvdwc_scpp(j,i),j=1,3)
10256 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10258 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10259 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10260 (gelc_loc_long(j,i),j=1,3)
10267 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10268 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10269 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10270 wel_loc*gel_loc_long(j,i)+ &
10271 wcorr*gradcorr_long(j,i)+ &
10272 wcorr5*gradcorr5_long(j,i)+ &
10273 wcorr6*gradcorr6_long(j,i)+ &
10274 wturn6*gcorr6_turn_long(j,i)+ &
10275 wstrain*ghpbc(j,i) &
10276 +wliptran*gliptranc(j,i) &
10278 +welec*gshieldc(j,i) &
10279 +wcorr*gshieldc_ec(j,i) &
10280 +wturn3*gshieldc_t3(j,i)&
10281 +wturn4*gshieldc_t4(j,i)&
10282 +wel_loc*gshieldc_ll(j,i)&
10283 +wtube*gg_tube(j,i)
10292 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10293 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10294 welec*gelc_long(j,i)+ &
10295 wbond*gradb(j,i)+ &
10296 wel_loc*gel_loc_long(j,i)+ &
10297 wcorr*gradcorr_long(j,i)+ &
10298 wcorr5*gradcorr5_long(j,i)+ &
10299 wcorr6*gradcorr6_long(j,i)+ &
10300 wturn6*gcorr6_turn_long(j,i)+ &
10301 wstrain*ghpbc(j,i) &
10302 +wliptran*gliptranc(j,i) &
10304 +welec*gshieldc(j,i)&
10305 +wcorr*gshieldc_ec(j,i) &
10306 +wturn4*gshieldc_t4(j,i) &
10307 +wel_loc*gshieldc_ll(j,i)&
10308 +wtube*gg_tube(j,i)
10316 if (nfgtasks.gt.1) then
10319 write (iout,*) "gradbufc before allreduce"
10321 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10327 gradbufc_sum(j,i)=gradbufc(j,i)
10330 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10331 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10332 ! time_reduce=time_reduce+MPI_Wtime()-time00
10334 ! write (iout,*) "gradbufc_sum after allreduce"
10336 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10341 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10345 gradbufc(k,i)=0.0d0
10349 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10350 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10351 " jgrad_end ",jgrad_end(i),&
10352 i=igrad_start,igrad_end)
10355 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10356 ! do not parallelize this part.
10358 ! do i=igrad_start,igrad_end
10359 ! do j=jgrad_start(i),jgrad_end(i)
10361 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10366 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10370 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10374 write (iout,*) "gradbufc after summing"
10376 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10384 write (iout,*) "gradbufc"
10386 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10393 gradbufc_sum(j,i)=gradbufc(j,i)
10394 gradbufc(j,i)=0.0d0
10398 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10402 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10407 ! gradbufc(k,i)=0.0d0
10411 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10417 write (iout,*) "gradbufc after summing"
10419 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10428 gradbufc(k,nres)=0.0d0
10430 !el----------------
10431 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10432 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10433 !el-----------------
10437 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10438 wel_loc*gel_loc(j,i)+ &
10439 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10440 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10441 wel_loc*gel_loc_long(j,i)+ &
10442 wcorr*gradcorr_long(j,i)+ &
10443 wcorr5*gradcorr5_long(j,i)+ &
10444 wcorr6*gradcorr6_long(j,i)+ &
10445 wturn6*gcorr6_turn_long(j,i))+ &
10446 wbond*gradb(j,i)+ &
10447 wcorr*gradcorr(j,i)+ &
10448 wturn3*gcorr3_turn(j,i)+ &
10449 wturn4*gcorr4_turn(j,i)+ &
10450 wcorr5*gradcorr5(j,i)+ &
10451 wcorr6*gradcorr6(j,i)+ &
10452 wturn6*gcorr6_turn(j,i)+ &
10453 wsccor*gsccorc(j,i) &
10454 +wscloc*gscloc(j,i) &
10455 +wliptran*gliptranc(j,i) &
10457 +welec*gshieldc(j,i) &
10458 +welec*gshieldc_loc(j,i) &
10459 +wcorr*gshieldc_ec(j,i) &
10460 +wcorr*gshieldc_loc_ec(j,i) &
10461 +wturn3*gshieldc_t3(j,i) &
10462 +wturn3*gshieldc_loc_t3(j,i) &
10463 +wturn4*gshieldc_t4(j,i) &
10464 +wturn4*gshieldc_loc_t4(j,i) &
10465 +wel_loc*gshieldc_ll(j,i) &
10466 +wel_loc*gshieldc_loc_ll(j,i) &
10467 +wtube*gg_tube(j,i)
10471 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10472 wel_loc*gel_loc(j,i)+ &
10473 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10474 welec*gelc_long(j,i)+ &
10475 wel_loc*gel_loc_long(j,i)+ &
10476 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10477 wcorr5*gradcorr5_long(j,i)+ &
10478 wcorr6*gradcorr6_long(j,i)+ &
10479 wturn6*gcorr6_turn_long(j,i))+ &
10480 wbond*gradb(j,i)+ &
10481 wcorr*gradcorr(j,i)+ &
10482 wturn3*gcorr3_turn(j,i)+ &
10483 wturn4*gcorr4_turn(j,i)+ &
10484 wcorr5*gradcorr5(j,i)+ &
10485 wcorr6*gradcorr6(j,i)+ &
10486 wturn6*gcorr6_turn(j,i)+ &
10487 wsccor*gsccorc(j,i) &
10488 +wscloc*gscloc(j,i) &
10490 +wliptran*gliptranc(j,i) &
10491 +welec*gshieldc(j,i) &
10492 +welec*gshieldc_loc(j,) &
10493 +wcorr*gshieldc_ec(j,i) &
10494 +wcorr*gshieldc_loc_ec(j,i) &
10495 +wturn3*gshieldc_t3(j,i) &
10496 +wturn3*gshieldc_loc_t3(j,i) &
10497 +wturn4*gshieldc_t4(j,i) &
10498 +wturn4*gshieldc_loc_t4(j,i) &
10499 +wel_loc*gshieldc_ll(j,i) &
10500 +wel_loc*gshieldc_loc_ll(j,i) &
10501 +wtube*gg_tube(j,i)
10506 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10507 wbond*gradbx(j,i)+ &
10508 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10509 wsccor*gsccorx(j,i) &
10510 +wscloc*gsclocx(j,i) &
10511 +wliptran*gliptranx(j,i) &
10512 +welec*gshieldx(j,i) &
10513 +wcorr*gshieldx_ec(j,i) &
10514 +wturn3*gshieldx_t3(j,i) &
10515 +wturn4*gshieldx_t4(j,i) &
10516 +wel_loc*gshieldx_ll(j,i)&
10517 +wtube*gg_tube_sc(j,i)
10523 write (iout,*) "gloc before adding corr"
10525 write (iout,*) i,gloc(i,icg)
10529 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10530 +wcorr5*g_corr5_loc(i) &
10531 +wcorr6*g_corr6_loc(i) &
10532 +wturn4*gel_loc_turn4(i) &
10533 +wturn3*gel_loc_turn3(i) &
10534 +wturn6*gel_loc_turn6(i) &
10535 +wel_loc*gel_loc_loc(i)
10538 write (iout,*) "gloc after adding corr"
10540 write (iout,*) i,gloc(i,icg)
10544 if (nfgtasks.gt.1) then
10547 gradbufc(j,i)=gradc(j,i,icg)
10548 gradbufx(j,i)=gradx(j,i,icg)
10552 glocbuf(i)=gloc(i,icg)
10556 write (iout,*) "gloc_sc before reduce"
10559 write (iout,*) i,j,gloc_sc(j,i,icg)
10566 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10570 call MPI_Barrier(FG_COMM,IERR)
10571 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10573 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10574 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10575 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
10576 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10577 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10578 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10579 time_reduce=time_reduce+MPI_Wtime()-time00
10580 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10581 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10582 time_reduce=time_reduce+MPI_Wtime()-time00
10585 write (iout,*) "gloc_sc after reduce"
10588 write (iout,*) i,j,gloc_sc(j,i,icg)
10594 write (iout,*) "gloc after reduce"
10596 write (iout,*) i,gloc(i,icg)
10601 if (gnorm_check) then
10603 ! Compute the maximum elements of the gradient
10606 gvdwc_scp_max=0.0d0
10613 gcorr3_turn_max=0.0d0
10614 gcorr4_turn_max=0.0d0
10615 gradcorr5_max=0.0d0
10616 gradcorr6_max=0.0d0
10617 gcorr6_turn_max=0.0d0
10621 gradx_scp_max=0.0d0
10627 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10628 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10629 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10630 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10631 gvdwc_scp_max=gvdwc_scp_norm
10632 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10633 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10634 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10635 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10636 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10637 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10638 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10639 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10640 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10641 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10642 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10643 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10644 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10646 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10647 gcorr3_turn_max=gcorr3_turn_norm
10648 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10650 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10651 gcorr4_turn_max=gcorr4_turn_norm
10652 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10653 if (gradcorr5_norm.gt.gradcorr5_max) &
10654 gradcorr5_max=gradcorr5_norm
10655 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10656 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10657 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10659 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10660 gcorr6_turn_max=gcorr6_turn_norm
10661 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10662 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10663 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10664 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10665 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10666 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10667 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10668 if (gradx_scp_norm.gt.gradx_scp_max) &
10669 gradx_scp_max=gradx_scp_norm
10670 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10671 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10672 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10673 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10674 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10675 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10676 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10677 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10681 open(istat,file=statname,position="append")
10683 open(istat,file=statname,access="append")
10685 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10686 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10687 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
10688 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
10689 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
10690 gsccorx_max,gsclocx_max
10692 if (gvdwc_max.gt.1.0d4) then
10693 write (iout,*) "gvdwc gvdwx gradb gradbx"
10695 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
10696 gradb(j,i),gradbx(j,i),j=1,3)
10698 call pdbout(0.0d0,'cipiszcze',iout)
10705 write (iout,*) "gradc gradx gloc"
10707 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
10708 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
10713 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
10716 end subroutine sum_gradient
10717 !-----------------------------------------------------------------------------
10719 ! implicit real*8 (a-h,o-z)
10721 ! include 'DIMENSIONS'
10722 ! include 'COMMON.CHAIN'
10723 ! include 'COMMON.DERIV'
10724 ! include 'COMMON.CALC'
10725 ! include 'COMMON.IOUNITS'
10726 real(kind=8), dimension(3) :: dcosom1,dcosom2
10728 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
10729 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
10730 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
10731 -2.0D0*alf12*eps3der+sigder*sigsq_om12
10735 ! eom12=evdwij*eps1_om12
10737 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
10739 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
10740 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
10741 !C print *,sss_ele_cut,'in sc_grad'
10743 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
10744 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
10747 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
10748 !C print *,'gg',k,gg(k)
10750 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
10751 ! write (iout,*) "gg",(gg(k),k=1,3)
10753 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
10754 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10755 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
10758 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
10759 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10760 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
10763 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10764 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
10765 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10766 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
10769 ! Calculate the components of the gradient in DC and X
10773 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
10777 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
10778 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
10781 end subroutine sc_grad
10783 !-----------------------------------------------------------------------------
10784 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
10787 ! implicit real*8 (a-h,o-z)
10788 ! include 'DIMENSIONS'
10789 ! include 'COMMON.LOCAL'
10790 ! include 'COMMON.IOUNITS'
10791 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
10792 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10793 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
10794 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
10795 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
10797 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
10798 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10799 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
10800 !el local variables
10802 delthec=thetai-thet_pred_mean
10803 delthe0=thetai-theta0i
10804 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
10805 t3 = thetai-thet_pred_mean
10809 t14 = t12+t6*sigsqtc
10811 t21 = thetai-theta0i
10817 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
10818 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
10819 *(-t12*t9-ak*sig0inv*t27)
10821 end subroutine mixder
10823 !-----------------------------------------------------------------------------
10825 !-----------------------------------------------------------------------------
10827 !-----------------------------------------------------------------------------
10828 ! This subroutine calculates the derivatives of the consecutive virtual
10829 ! bond vectors and the SC vectors in the virtual-bond angles theta and
10830 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
10831 ! in the angles alpha and omega, describing the location of a side chain
10832 ! in its local coordinate system.
10834 ! The derivatives are stored in the following arrays:
10836 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
10837 ! The structure is as follows:
10839 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
10840 ! 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)
10841 ! . . . . . . . . . . . . . . . . . .
10842 ! 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)
10846 ! 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)
10848 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
10849 ! The structure is same as above.
10851 ! DCDS - the derivatives of the side chain vectors in the local spherical
10852 ! andgles alph and omega:
10854 ! 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)
10855 ! 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)
10859 ! 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)
10861 ! Version of March '95, based on an early version of November '91.
10863 !**********************************************************************
10864 ! implicit real*8 (a-h,o-z)
10865 ! include 'DIMENSIONS'
10866 ! include 'COMMON.VAR'
10867 ! include 'COMMON.CHAIN'
10868 ! include 'COMMON.DERIV'
10869 ! include 'COMMON.GEO'
10870 ! include 'COMMON.LOCAL'
10871 ! include 'COMMON.INTERACT'
10872 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
10873 real(kind=8),dimension(3,3) :: dp,temp
10874 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
10875 real(kind=8),dimension(3) :: xx,xx1
10876 !el local variables
10877 integer :: i,k,l,j,m,ind,ind1,jjj
10878 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
10879 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
10880 sint2,xp,yp,xxp,yyp,zzp,dj
10882 ! common /przechowalnia/ fromto
10883 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
10884 ! get the position of the jth ijth fragment of the chain coordinate system
10885 ! in the fromto array.
10886 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
10888 ! maxdim=(nres-1)*(nres-2)/2
10889 ! allocate(dcdv(6,maxdim),dxds(6,nres))
10890 ! calculate the derivatives of transformation matrix elements in theta
10893 !el call flush(iout) !el
10895 rdt(1,1,i)=-rt(1,2,i)
10896 rdt(1,2,i)= rt(1,1,i)
10898 rdt(2,1,i)=-rt(2,2,i)
10899 rdt(2,2,i)= rt(2,1,i)
10901 rdt(3,1,i)=-rt(3,2,i)
10902 rdt(3,2,i)= rt(3,1,i)
10906 ! derivatives in phi
10912 drt(2,1,i)= rt(3,1,i)
10913 drt(2,2,i)= rt(3,2,i)
10914 drt(2,3,i)= rt(3,3,i)
10915 drt(3,1,i)=-rt(2,1,i)
10916 drt(3,2,i)=-rt(2,2,i)
10917 drt(3,3,i)=-rt(2,3,i)
10920 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
10926 temp(k,l)=rt(k,l,i)
10931 fromto(k,l,ind)=temp(k,l)
10940 dpkl=dpkl+temp(k,m)*rt(m,l,j)
10943 fromto(k,l,ind)=dpkl
10954 ! Calculate derivatives.
10960 ! Derivatives of DC(i+1) in theta(i+2)
10966 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
10969 prordt(j,k,i)=dp(j,k)
10972 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
10975 ! Derivatives of SC(i+1) in theta(i+2)
10977 xx1(1)=-0.5D0*xloc(2,i+1)
10978 xx1(2)= 0.5D0*xloc(1,i+1)
10982 xj=xj+r(j,k,i)*xx1(k)
10989 rj=rj+prod(j,k,i)*xx(k)
10994 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
10995 ! than the other off-diagonal derivatives.
11000 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11002 dxdv(j,ind1+1)=dxoiij
11004 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11006 ! Derivatives of DC(i+1) in phi(i+2)
11012 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11015 prodrt(j,k,i)=dp(j,k)
11017 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11020 ! Derivatives of SC(i+1) in phi(i+2)
11023 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11024 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11028 rj=rj+prod(j,k,i)*xx(k)
11033 ! Derivatives of SC(i+1) in phi(i+3).
11038 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11040 dxdv(j+3,ind1+1)=dxoiij
11043 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11044 ! theta(nres) and phi(i+3) thru phi(nres).
11048 ind=indmat(i+1,j+1)
11049 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11054 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11059 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11060 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11061 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11062 ! Derivatives of virtual-bond vectors in theta
11064 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11066 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11067 ! Derivatives of SC vectors in theta
11071 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11073 dxdv(k,ind1+1)=dxoijk
11076 !--- Calculate the derivatives in phi
11082 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11088 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11093 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11095 dxdv(k+3,ind1+1)=dxoijk
11100 ! Derivatives in alpha and omega:
11103 ! dsci=dsc(itype(i,1))
11108 if(alphi.ne.alphi) alphi=100.0
11109 if(omegi.ne.omegi) omegi=-100.0
11114 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11115 cosalphi=dcos(alphi)
11116 sinalphi=dsin(alphi)
11117 cosomegi=dcos(omegi)
11118 sinomegi=dsin(omegi)
11119 temp(1,1)=-dsci*sinalphi
11120 temp(2,1)= dsci*cosalphi*cosomegi
11121 temp(3,1)=-dsci*cosalphi*sinomegi
11123 temp(2,2)=-dsci*sinalphi*sinomegi
11124 temp(3,2)=-dsci*sinalphi*cosomegi
11125 theta2=pi-0.5D0*theta(i+1)
11129 !d print *,((temp(l,k),l=1,3),k=1,2)
11133 xxp= xp*cost2+yp*sint2
11134 yyp=-xp*sint2+yp*cost2
11137 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11138 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11142 dj=dj+prod(k,l,i-1)*xx(l)
11150 end subroutine cartder
11151 !-----------------------------------------------------------------------------
11153 !-----------------------------------------------------------------------------
11154 subroutine check_cartgrad
11155 ! Check the gradient of Cartesian coordinates in internal coordinates.
11156 ! implicit real*8 (a-h,o-z)
11157 ! include 'DIMENSIONS'
11158 ! include 'COMMON.IOUNITS'
11159 ! include 'COMMON.VAR'
11160 ! include 'COMMON.CHAIN'
11161 ! include 'COMMON.GEO'
11162 ! include 'COMMON.LOCAL'
11163 ! include 'COMMON.DERIV'
11164 real(kind=8),dimension(6,nres) :: temp
11165 real(kind=8),dimension(3) :: xx,gg
11166 integer :: i,k,j,ii
11167 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11168 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11170 ! Check the gradient of the virtual-bond and SC vectors in the internal
11176 write (iout,'(a)') '**************** dx/dalpha'
11180 alph(i)=alph(i)+aincr
11182 temp(k,i)=dc(k,nres+i)
11186 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11187 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11189 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11190 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11196 write (iout,'(a)') '**************** dx/domega'
11200 omeg(i)=omeg(i)+aincr
11202 temp(k,i)=dc(k,nres+i)
11206 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11207 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11208 (aincr*dabs(dxds(k+3,i))+aincr))
11210 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11211 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11217 write (iout,'(a)') '**************** dx/dtheta'
11221 theta(i)=theta(i)+aincr
11224 temp(k,j)=dc(k,nres+j)
11230 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11232 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11233 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11234 (aincr*dabs(dxdv(k,ii))+aincr))
11236 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11237 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11244 write (iout,'(a)') '***************** dx/dphi'
11247 phi(i)=phi(i)+aincr
11250 temp(k,j)=dc(k,nres+j)
11258 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11259 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11260 (aincr*dabs(dxdv(k+3,ii))+aincr))
11262 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11263 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11266 phi(i)=phi(i)-aincr
11269 write (iout,'(a)') '****************** ddc/dtheta'
11272 theta(i+2)=thet+aincr
11283 gg(k)=(dc(k,j)-temp(k,j))/aincr
11284 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11285 (aincr*dabs(dcdv(k,ii))+aincr))
11287 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11288 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11298 write (iout,'(a)') '******************* ddc/dphi'
11301 phi(i+3)=phii+aincr
11312 gg(k)=(dc(k,j)-temp(k,j))/aincr
11313 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11314 (aincr*dabs(dcdv(k+3,ii))+aincr))
11316 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11317 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11328 end subroutine check_cartgrad
11329 !-----------------------------------------------------------------------------
11330 subroutine check_ecart
11331 ! Check the gradient of the energy in Cartesian coordinates.
11332 ! implicit real*8 (a-h,o-z)
11333 ! include 'DIMENSIONS'
11334 ! include 'COMMON.CHAIN'
11335 ! include 'COMMON.DERIV'
11336 ! include 'COMMON.IOUNITS'
11337 ! include 'COMMON.VAR'
11338 ! include 'COMMON.CONTACTS'
11340 !el integer :: icall
11341 !el common /srutu/ icall
11342 real(kind=8),dimension(6) :: ggg
11343 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11344 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11345 real(kind=8),dimension(6,nres) :: grad_s
11346 real(kind=8),dimension(0:n_ene) :: energia,energia1
11347 integer :: uiparm(1)
11348 real(kind=8) :: urparm(1)
11350 integer :: nf,i,j,k
11351 real(kind=8) :: aincr,etot,etot1
11357 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11360 call geom_to_var(nvar,x)
11361 call etotal(energia)
11363 !el call enerprint(energia)
11364 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11367 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11371 grad_s(j,i)=gradc(j,i,icg)
11372 grad_s(j+3,i)=gradx(j,i,icg)
11376 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11381 ddx(j)=dc(j,i+nres)
11384 dc(j,i)=dc(j,i)+aincr
11386 c(j,k)=c(j,k)+aincr
11387 c(j,k+nres)=c(j,k+nres)+aincr
11389 call etotal(energia1)
11391 ggg(j)=(etot1-etot)/aincr
11394 c(j,k)=c(j,k)-aincr
11395 c(j,k+nres)=c(j,k+nres)-aincr
11399 c(j,i+nres)=c(j,i+nres)+aincr
11400 dc(j,i+nres)=dc(j,i+nres)+aincr
11401 call etotal(energia1)
11403 ggg(j+3)=(etot1-etot)/aincr
11405 dc(j,i+nres)=ddx(j)
11407 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11408 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11411 end subroutine check_ecart
11413 !-----------------------------------------------------------------------------
11414 subroutine check_ecartint
11415 ! Check the gradient of the energy in Cartesian coordinates.
11416 use io_base, only: intout
11417 ! implicit real*8 (a-h,o-z)
11418 ! include 'DIMENSIONS'
11419 ! include 'COMMON.CONTROL'
11420 ! include 'COMMON.CHAIN'
11421 ! include 'COMMON.DERIV'
11422 ! include 'COMMON.IOUNITS'
11423 ! include 'COMMON.VAR'
11424 ! include 'COMMON.CONTACTS'
11425 ! include 'COMMON.MD'
11426 ! include 'COMMON.LOCAL'
11427 ! include 'COMMON.SPLITELE'
11429 !el integer :: icall
11430 !el common /srutu/ icall
11431 real(kind=8),dimension(6) :: ggg,ggg1
11432 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11433 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11434 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11435 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11436 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11437 real(kind=8),dimension(0:n_ene) :: energia,energia1
11438 integer :: uiparm(1)
11439 real(kind=8) :: urparm(1)
11441 integer :: i,j,k,nf
11442 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11450 ! call intcartderiv
11451 ! call checkintcartgrad
11454 write(iout,*) 'Calling CHECK_ECARTINT.'
11457 write (iout,*) "Before geom_to_var"
11458 call geom_to_var(nvar,x)
11459 write (iout,*) "after geom_to_var"
11460 write (iout,*) "split_ene ",split_ene
11462 if (.not.split_ene) then
11463 write(iout,*) 'Calling CHECK_ECARTINT if'
11464 call etotal(energia)
11465 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11467 write (iout,*) "etot",etot
11469 !el call enerprint(energia)
11470 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11472 write (iout,*) "enter cartgrad"
11475 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11476 write (iout,*) "exit cartgrad"
11480 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11483 grad_s(j,0)=gcart(j,0)
11485 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11488 grad_s(j,i)=gcart(j,i)
11489 grad_s(j+3,i)=gxcart(j,i)
11493 write(iout,*) 'Calling CHECK_ECARTIN else.'
11494 !- split gradient check
11496 call etotal_long(energia)
11497 !el call enerprint(energia)
11499 write (iout,*) "enter cartgrad"
11502 write (iout,*) "exit cartgrad"
11505 write (iout,*) "longrange grad"
11507 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11508 (gxcart(j,i),j=1,3)
11511 grad_s(j,0)=gcart(j,0)
11515 grad_s(j,i)=gcart(j,i)
11516 grad_s(j+3,i)=gxcart(j,i)
11520 call etotal_short(energia)
11521 !el call enerprint(energia)
11523 write (iout,*) "enter cartgrad"
11526 write (iout,*) "exit cartgrad"
11529 write (iout,*) "shortrange grad"
11531 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11532 (gxcart(j,i),j=1,3)
11535 grad_s1(j,0)=gcart(j,0)
11539 grad_s1(j,i)=gcart(j,i)
11540 grad_s1(j+3,i)=gxcart(j,i)
11544 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11548 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11549 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11552 dcnorm_safe1(j)=dc_norm(j,i-1)
11553 dcnorm_safe2(j)=dc_norm(j,i)
11554 dxnorm_safe(j)=dc_norm(j,i+nres)
11557 c(j,i)=ddc(j)+aincr
11558 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11559 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11560 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11561 dc(j,i)=c(j,i+1)-c(j,i)
11562 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11563 call int_from_cart1(.false.)
11564 if (.not.split_ene) then
11565 call etotal(energia1)
11567 write (iout,*) "ij",i,j," etot1",etot1
11570 call etotal_long(energia1)
11572 call etotal_short(energia1)
11575 !- end split gradient
11576 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11577 c(j,i)=ddc(j)-aincr
11578 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11579 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11580 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11581 dc(j,i)=c(j,i+1)-c(j,i)
11582 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11583 call int_from_cart1(.false.)
11584 if (.not.split_ene) then
11585 call etotal(energia1)
11587 write (iout,*) "ij",i,j," etot2",etot2
11588 ggg(j)=(etot1-etot2)/(2*aincr)
11591 call etotal_long(energia1)
11593 ggg(j)=(etot11-etot21)/(2*aincr)
11594 call etotal_short(energia1)
11596 ggg1(j)=(etot12-etot22)/(2*aincr)
11597 !- end split gradient
11598 ! write (iout,*) "etot21",etot21," etot22",etot22
11600 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11602 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11603 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11604 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11605 dc(j,i)=c(j,i+1)-c(j,i)
11606 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11607 dc_norm(j,i-1)=dcnorm_safe1(j)
11608 dc_norm(j,i)=dcnorm_safe2(j)
11609 dc_norm(j,i+nres)=dxnorm_safe(j)
11612 c(j,i+nres)=ddx(j)+aincr
11613 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11614 call int_from_cart1(.false.)
11615 if (.not.split_ene) then
11616 call etotal(energia1)
11620 call etotal_long(energia1)
11622 call etotal_short(energia1)
11625 !- end split gradient
11626 c(j,i+nres)=ddx(j)-aincr
11627 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11628 call int_from_cart1(.false.)
11629 if (.not.split_ene) then
11630 call etotal(energia1)
11632 ggg(j+3)=(etot1-etot2)/(2*aincr)
11635 call etotal_long(energia1)
11637 ggg(j+3)=(etot11-etot21)/(2*aincr)
11638 call etotal_short(energia1)
11640 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11641 !- end split gradient
11643 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11645 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11646 dc_norm(j,i+nres)=dxnorm_safe(j)
11647 call int_from_cart1(.false.)
11649 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11650 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11651 if (split_ene) then
11652 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11653 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11655 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11656 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11657 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11661 end subroutine check_ecartint
11663 !-----------------------------------------------------------------------------
11664 subroutine check_ecartint
11665 ! Check the gradient of the energy in Cartesian coordinates.
11666 use io_base, only: intout
11667 ! implicit real*8 (a-h,o-z)
11668 ! include 'DIMENSIONS'
11669 ! include 'COMMON.CONTROL'
11670 ! include 'COMMON.CHAIN'
11671 ! include 'COMMON.DERIV'
11672 ! include 'COMMON.IOUNITS'
11673 ! include 'COMMON.VAR'
11674 ! include 'COMMON.CONTACTS'
11675 ! include 'COMMON.MD'
11676 ! include 'COMMON.LOCAL'
11677 ! include 'COMMON.SPLITELE'
11679 !el integer :: icall
11680 !el common /srutu/ icall
11681 real(kind=8),dimension(6) :: ggg,ggg1
11682 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11683 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11684 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11685 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11686 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11687 real(kind=8),dimension(0:n_ene) :: energia,energia1
11688 integer :: uiparm(1)
11689 real(kind=8) :: urparm(1)
11691 integer :: i,j,k,nf
11692 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11700 ! call intcartderiv
11701 ! call checkintcartgrad
11704 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
11707 call geom_to_var(nvar,x)
11708 if (.not.split_ene) then
11709 call etotal(energia)
11711 !el call enerprint(energia)
11713 write (iout,*) "enter cartgrad"
11716 write (iout,*) "exit cartgrad"
11720 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11723 grad_s(j,0)=gcart(j,0)
11727 grad_s(j,i)=gcart(j,i)
11728 grad_s(j+3,i)=gxcart(j,i)
11732 !- split gradient check
11734 call etotal_long(energia)
11735 !el call enerprint(energia)
11737 write (iout,*) "enter cartgrad"
11740 write (iout,*) "exit cartgrad"
11743 write (iout,*) "longrange grad"
11745 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11746 (gxcart(j,i),j=1,3)
11749 grad_s(j,0)=gcart(j,0)
11753 grad_s(j,i)=gcart(j,i)
11754 grad_s(j+3,i)=gxcart(j,i)
11758 call etotal_short(energia)
11759 !el call enerprint(energia)
11761 write (iout,*) "enter cartgrad"
11764 write (iout,*) "exit cartgrad"
11767 write (iout,*) "shortrange grad"
11769 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11770 (gxcart(j,i),j=1,3)
11773 grad_s1(j,0)=gcart(j,0)
11777 grad_s1(j,i)=gcart(j,i)
11778 grad_s1(j+3,i)=gxcart(j,i)
11782 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11787 ddx(j)=dc(j,i+nres)
11789 dcnorm_safe(k)=dc_norm(k,i)
11790 dxnorm_safe(k)=dc_norm(k,i+nres)
11794 dc(j,i)=ddc(j)+aincr
11795 call chainbuild_cart
11797 ! Broadcast the order to compute internal coordinates to the slaves.
11798 ! if (nfgtasks.gt.1)
11799 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
11801 ! call int_from_cart1(.false.)
11802 if (.not.split_ene) then
11803 call etotal(energia1)
11807 call etotal_long(energia1)
11809 call etotal_short(energia1)
11811 ! write (iout,*) "etot11",etot11," etot12",etot12
11813 !- end split gradient
11814 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11815 dc(j,i)=ddc(j)-aincr
11816 call chainbuild_cart
11817 ! call int_from_cart1(.false.)
11818 if (.not.split_ene) then
11819 call etotal(energia1)
11821 ggg(j)=(etot1-etot2)/(2*aincr)
11824 call etotal_long(energia1)
11826 ggg(j)=(etot11-etot21)/(2*aincr)
11827 call etotal_short(energia1)
11829 ggg1(j)=(etot12-etot22)/(2*aincr)
11830 !- end split gradient
11831 ! write (iout,*) "etot21",etot21," etot22",etot22
11833 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11835 call chainbuild_cart
11838 dc(j,i+nres)=ddx(j)+aincr
11839 call chainbuild_cart
11840 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
11841 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11842 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11843 ! write (iout,*) "dxnormnorm",dsqrt(
11844 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11845 ! write (iout,*) "dxnormnormsafe",dsqrt(
11846 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11848 if (.not.split_ene) then
11849 call etotal(energia1)
11853 call etotal_long(energia1)
11855 call etotal_short(energia1)
11858 !- end split gradient
11859 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11860 dc(j,i+nres)=ddx(j)-aincr
11861 call chainbuild_cart
11862 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
11863 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11864 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11866 ! write (iout,*) "dxnormnorm",dsqrt(
11867 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11868 ! write (iout,*) "dxnormnormsafe",dsqrt(
11869 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11870 if (.not.split_ene) then
11871 call etotal(energia1)
11873 ggg(j+3)=(etot1-etot2)/(2*aincr)
11876 call etotal_long(energia1)
11878 ggg(j+3)=(etot11-etot21)/(2*aincr)
11879 call etotal_short(energia1)
11881 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11882 !- end split gradient
11884 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11885 dc(j,i+nres)=ddx(j)
11886 call chainbuild_cart
11888 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11889 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11890 if (split_ene) then
11891 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11892 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11894 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11895 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11896 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11900 end subroutine check_ecartint
11902 !-----------------------------------------------------------------------------
11903 subroutine check_eint
11904 ! Check the gradient of energy in internal coordinates.
11905 ! implicit real*8 (a-h,o-z)
11906 ! include 'DIMENSIONS'
11907 ! include 'COMMON.CHAIN'
11908 ! include 'COMMON.DERIV'
11909 ! include 'COMMON.IOUNITS'
11910 ! include 'COMMON.VAR'
11911 ! include 'COMMON.GEO'
11913 !el integer :: icall
11914 !el common /srutu/ icall
11915 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
11916 integer :: uiparm(1)
11917 real(kind=8) :: urparm(1)
11918 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
11919 character(len=6) :: key
11922 real(kind=8) :: xi,aincr,etot,etot1,etot2
11925 print '(a)','Calling CHECK_INT.'
11929 call geom_to_var(nvar,x)
11930 call var_to_geom(nvar,x)
11934 call etotal(energia)
11936 !el call enerprint(energia)
11939 if (MyID.ne.BossID) then
11940 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
11948 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
11949 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
11950 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
11954 x(i)=xi-0.5D0*aincr
11955 call var_to_geom(nvar,x)
11957 call etotal(energia1)
11959 x(i)=xi+0.5D0*aincr
11960 call var_to_geom(nvar,x)
11962 call etotal(energia2)
11964 gg(i)=(etot2-etot1)/aincr
11965 write (iout,*) i,etot1,etot2
11968 write (iout,'(/2a)')' Variable Numerical Analytical',&
11971 if (i.le.nphi) then
11974 else if (i.le.nphi+ntheta) then
11977 else if (i.le.nphi+ntheta+nside) then
11981 ii=i-(nphi+ntheta+nside)
11984 write (iout,'(i3,a,i3,3(1pd16.6))') &
11985 i,key,ii,gg(i),gana(i),&
11986 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
11989 end subroutine check_eint
11990 !-----------------------------------------------------------------------------
11992 !-----------------------------------------------------------------------------
11993 subroutine Econstr_back
11994 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
11995 ! implicit real*8 (a-h,o-z)
11996 ! include 'DIMENSIONS'
11997 ! include 'COMMON.CONTROL'
11998 ! include 'COMMON.VAR'
11999 ! include 'COMMON.MD'
12002 ! include 'COMMON.LANGEVIN'
12004 ! include 'COMMON.LANGEVIN.lang0'
12006 ! include 'COMMON.CHAIN'
12007 ! include 'COMMON.DERIV'
12008 ! include 'COMMON.GEO'
12009 ! include 'COMMON.LOCAL'
12010 ! include 'COMMON.INTERACT'
12011 ! include 'COMMON.IOUNITS'
12012 ! include 'COMMON.NAMES'
12013 ! include 'COMMON.TIME1'
12014 integer :: i,j,ii,k
12015 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12017 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12018 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12019 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12026 duscdiff(j,i)=0.0d0
12027 duscdiffx(j,i)=0.0d0
12031 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12033 ! Deviations from theta angles
12036 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12037 dtheta_i=theta(j)-thetaref(j)
12038 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12039 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12041 utheta(i)=utheta_i/(ii-1)
12043 ! Deviations from gamma angles
12046 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12047 dgamma_i=pinorm(phi(j)-phiref(j))
12048 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12049 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12050 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12051 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12053 ugamma(i)=ugamma_i/(ii-2)
12055 ! Deviations from local SC geometry
12058 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12059 dxx=xxtab(j)-xxref(j)
12060 dyy=yytab(j)-yyref(j)
12061 dzz=zztab(j)-zzref(j)
12062 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12064 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12065 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12067 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12068 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12070 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12071 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12074 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12075 ! & xxref(j),yyref(j),zzref(j)
12077 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12078 ! write (iout,*) i," uscdiff",uscdiff(i)
12080 ! Put together deviations from local geometry
12082 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12083 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12084 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12085 ! & " uconst_back",uconst_back
12086 utheta(i)=dsqrt(utheta(i))
12087 ugamma(i)=dsqrt(ugamma(i))
12088 uscdiff(i)=dsqrt(uscdiff(i))
12091 end subroutine Econstr_back
12092 !-----------------------------------------------------------------------------
12093 ! energy_p_new-sep_barrier.F
12094 !-----------------------------------------------------------------------------
12095 real(kind=8) function sscale(r)
12096 ! include "COMMON.SPLITELE"
12097 real(kind=8) :: r,gamm
12098 if(r.lt.r_cut-rlamb) then
12100 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12101 gamm=(r-(r_cut-rlamb))/rlamb
12102 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12107 end function sscale
12108 real(kind=8) function sscale_grad(r)
12109 ! include "COMMON.SPLITELE"
12110 real(kind=8) :: r,gamm
12111 if(r.lt.r_cut-rlamb) then
12113 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12114 gamm=(r-(r_cut-rlamb))/rlamb
12115 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12120 end function sscale_grad
12122 !!!!!!!!!! PBCSCALE
12123 real(kind=8) function sscale_ele(r)
12124 ! include "COMMON.SPLITELE"
12125 real(kind=8) :: r,gamm
12126 if(r.lt.r_cut_ele-rlamb_ele) then
12128 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12129 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12130 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12135 end function sscale_ele
12137 real(kind=8) function sscagrad_ele(r)
12138 real(kind=8) :: r,gamm
12139 ! include "COMMON.SPLITELE"
12140 if(r.lt.r_cut_ele-rlamb_ele) then
12142 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12143 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12144 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12149 end function sscagrad_ele
12150 real(kind=8) function sscalelip(r)
12151 real(kind=8) r,gamm
12152 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12154 end function sscalelip
12155 !C-----------------------------------------------------------------------
12156 real(kind=8) function sscagradlip(r)
12157 real(kind=8) r,gamm
12158 sscagradlip=r*(6.0d0*r-6.0d0)
12160 end function sscagradlip
12163 !-----------------------------------------------------------------------------
12164 subroutine elj_long(evdw)
12166 ! This subroutine calculates the interaction energy of nonbonded side chains
12167 ! assuming the LJ potential of interaction.
12169 ! implicit real*8 (a-h,o-z)
12170 ! include 'DIMENSIONS'
12171 ! include 'COMMON.GEO'
12172 ! include 'COMMON.VAR'
12173 ! include 'COMMON.LOCAL'
12174 ! include 'COMMON.CHAIN'
12175 ! include 'COMMON.DERIV'
12176 ! include 'COMMON.INTERACT'
12177 ! include 'COMMON.TORSION'
12178 ! include 'COMMON.SBRIDGE'
12179 ! include 'COMMON.NAMES'
12180 ! include 'COMMON.IOUNITS'
12181 ! include 'COMMON.CONTACTS'
12182 real(kind=8),parameter :: accur=1.0d-10
12183 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12184 !el local variables
12185 integer :: i,iint,j,k,itypi,itypi1,itypj
12186 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12187 real(kind=8) :: e1,e2,evdwij,evdw
12188 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12190 do i=iatsc_s,iatsc_e
12192 if (itypi.eq.ntyp1) cycle
12193 itypi1=itype(i+1,1)
12198 ! Calculate SC interaction energy.
12200 do iint=1,nint_gr(i)
12201 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12202 !d & 'iend=',iend(i,iint)
12203 do j=istart(i,iint),iend(i,iint)
12205 if (itypj.eq.ntyp1) cycle
12209 rij=xj*xj+yj*yj+zj*zj
12210 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12211 if (sss.lt.1.0d0) then
12213 eps0ij=eps(itypi,itypj)
12215 e1=fac*fac*aa_aq(itypi,itypj)
12216 e2=fac*bb_aq(itypi,itypj)
12218 evdw=evdw+(1.0d0-sss)*evdwij
12220 ! Calculate the components of the gradient in DC and X
12222 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12227 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12228 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12229 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12230 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12238 gvdwc(j,i)=expon*gvdwc(j,i)
12239 gvdwx(j,i)=expon*gvdwx(j,i)
12242 !******************************************************************************
12246 ! To save time, the factor of EXPON has been extracted from ALL components
12247 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12250 !******************************************************************************
12252 end subroutine elj_long
12253 !-----------------------------------------------------------------------------
12254 subroutine elj_short(evdw)
12256 ! This subroutine calculates the interaction energy of nonbonded side chains
12257 ! assuming the LJ potential of interaction.
12259 ! implicit real*8 (a-h,o-z)
12260 ! include 'DIMENSIONS'
12261 ! include 'COMMON.GEO'
12262 ! include 'COMMON.VAR'
12263 ! include 'COMMON.LOCAL'
12264 ! include 'COMMON.CHAIN'
12265 ! include 'COMMON.DERIV'
12266 ! include 'COMMON.INTERACT'
12267 ! include 'COMMON.TORSION'
12268 ! include 'COMMON.SBRIDGE'
12269 ! include 'COMMON.NAMES'
12270 ! include 'COMMON.IOUNITS'
12271 ! include 'COMMON.CONTACTS'
12272 real(kind=8),parameter :: accur=1.0d-10
12273 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12274 !el local variables
12275 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12276 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12277 real(kind=8) :: e1,e2,evdwij,evdw
12278 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12280 do i=iatsc_s,iatsc_e
12282 if (itypi.eq.ntyp1) cycle
12283 itypi1=itype(i+1,1)
12290 ! Calculate SC interaction energy.
12292 do iint=1,nint_gr(i)
12293 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12294 !d & 'iend=',iend(i,iint)
12295 do j=istart(i,iint),iend(i,iint)
12297 if (itypj.eq.ntyp1) cycle
12301 ! Change 12/1/95 to calculate four-body interactions
12302 rij=xj*xj+yj*yj+zj*zj
12303 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12304 if (sss.gt.0.0d0) then
12306 eps0ij=eps(itypi,itypj)
12308 e1=fac*fac*aa_aq(itypi,itypj)
12309 e2=fac*bb_aq(itypi,itypj)
12311 evdw=evdw+sss*evdwij
12313 ! Calculate the components of the gradient in DC and X
12315 fac=-rrij*(e1+evdwij)*sss
12320 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12321 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12322 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12323 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12331 gvdwc(j,i)=expon*gvdwc(j,i)
12332 gvdwx(j,i)=expon*gvdwx(j,i)
12335 !******************************************************************************
12339 ! To save time, the factor of EXPON has been extracted from ALL components
12340 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12343 !******************************************************************************
12345 end subroutine elj_short
12346 !-----------------------------------------------------------------------------
12347 subroutine eljk_long(evdw)
12349 ! This subroutine calculates the interaction energy of nonbonded side chains
12350 ! assuming the LJK potential of interaction.
12352 ! implicit real*8 (a-h,o-z)
12353 ! include 'DIMENSIONS'
12354 ! include 'COMMON.GEO'
12355 ! include 'COMMON.VAR'
12356 ! include 'COMMON.LOCAL'
12357 ! include 'COMMON.CHAIN'
12358 ! include 'COMMON.DERIV'
12359 ! include 'COMMON.INTERACT'
12360 ! include 'COMMON.IOUNITS'
12361 ! include 'COMMON.NAMES'
12362 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12364 !el local variables
12365 integer :: i,iint,j,k,itypi,itypi1,itypj
12366 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12367 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12368 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12370 do i=iatsc_s,iatsc_e
12372 if (itypi.eq.ntyp1) cycle
12373 itypi1=itype(i+1,1)
12378 ! Calculate SC interaction energy.
12380 do iint=1,nint_gr(i)
12381 do j=istart(i,iint),iend(i,iint)
12383 if (itypj.eq.ntyp1) cycle
12387 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12388 fac_augm=rrij**expon
12389 e_augm=augm(itypi,itypj)*fac_augm
12390 r_inv_ij=dsqrt(rrij)
12392 sss=sscale(rij/sigma(itypi,itypj))
12393 if (sss.lt.1.0d0) then
12394 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12395 fac=r_shift_inv**expon
12396 e1=fac*fac*aa_aq(itypi,itypj)
12397 e2=fac*bb_aq(itypi,itypj)
12398 evdwij=e_augm+e1+e2
12399 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12400 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12401 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12402 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12403 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12404 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12405 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12406 evdw=evdw+(1.0d0-sss)*evdwij
12408 ! Calculate the components of the gradient in DC and X
12410 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12411 fac=fac*(1.0d0-sss)
12416 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12417 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12418 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12419 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12427 gvdwc(j,i)=expon*gvdwc(j,i)
12428 gvdwx(j,i)=expon*gvdwx(j,i)
12432 end subroutine eljk_long
12433 !-----------------------------------------------------------------------------
12434 subroutine eljk_short(evdw)
12436 ! This subroutine calculates the interaction energy of nonbonded side chains
12437 ! assuming the LJK potential of interaction.
12439 ! implicit real*8 (a-h,o-z)
12440 ! include 'DIMENSIONS'
12441 ! include 'COMMON.GEO'
12442 ! include 'COMMON.VAR'
12443 ! include 'COMMON.LOCAL'
12444 ! include 'COMMON.CHAIN'
12445 ! include 'COMMON.DERIV'
12446 ! include 'COMMON.INTERACT'
12447 ! include 'COMMON.IOUNITS'
12448 ! include 'COMMON.NAMES'
12449 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12451 !el local variables
12452 integer :: i,iint,j,k,itypi,itypi1,itypj
12453 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12454 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12455 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12457 do i=iatsc_s,iatsc_e
12459 if (itypi.eq.ntyp1) cycle
12460 itypi1=itype(i+1,1)
12465 ! Calculate SC interaction energy.
12467 do iint=1,nint_gr(i)
12468 do j=istart(i,iint),iend(i,iint)
12470 if (itypj.eq.ntyp1) cycle
12474 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12475 fac_augm=rrij**expon
12476 e_augm=augm(itypi,itypj)*fac_augm
12477 r_inv_ij=dsqrt(rrij)
12479 sss=sscale(rij/sigma(itypi,itypj))
12480 if (sss.gt.0.0d0) then
12481 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12482 fac=r_shift_inv**expon
12483 e1=fac*fac*aa_aq(itypi,itypj)
12484 e2=fac*bb_aq(itypi,itypj)
12485 evdwij=e_augm+e1+e2
12486 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12487 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12488 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12489 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12490 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12491 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12492 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12493 evdw=evdw+sss*evdwij
12495 ! Calculate the components of the gradient in DC and X
12497 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12503 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12504 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12505 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12506 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12514 gvdwc(j,i)=expon*gvdwc(j,i)
12515 gvdwx(j,i)=expon*gvdwx(j,i)
12519 end subroutine eljk_short
12520 !-----------------------------------------------------------------------------
12521 subroutine ebp_long(evdw)
12523 ! This subroutine calculates the interaction energy of nonbonded side chains
12524 ! assuming the Berne-Pechukas potential of interaction.
12527 ! implicit real*8 (a-h,o-z)
12528 ! include 'DIMENSIONS'
12529 ! include 'COMMON.GEO'
12530 ! include 'COMMON.VAR'
12531 ! include 'COMMON.LOCAL'
12532 ! include 'COMMON.CHAIN'
12533 ! include 'COMMON.DERIV'
12534 ! include 'COMMON.NAMES'
12535 ! include 'COMMON.INTERACT'
12536 ! include 'COMMON.IOUNITS'
12537 ! include 'COMMON.CALC'
12539 !el integer :: icall
12540 !el common /srutu/ icall
12541 ! double precision rrsave(maxdim)
12543 !el local variables
12544 integer :: iint,itypi,itypi1,itypj
12545 real(kind=8) :: rrij,xi,yi,zi,fac
12546 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12548 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12550 ! if (icall.eq.0) then
12556 do i=iatsc_s,iatsc_e
12558 if (itypi.eq.ntyp1) cycle
12559 itypi1=itype(i+1,1)
12563 dxi=dc_norm(1,nres+i)
12564 dyi=dc_norm(2,nres+i)
12565 dzi=dc_norm(3,nres+i)
12566 ! dsci_inv=dsc_inv(itypi)
12567 dsci_inv=vbld_inv(i+nres)
12569 ! Calculate SC interaction energy.
12571 do iint=1,nint_gr(i)
12572 do j=istart(i,iint),iend(i,iint)
12575 if (itypj.eq.ntyp1) cycle
12576 ! dscj_inv=dsc_inv(itypj)
12577 dscj_inv=vbld_inv(j+nres)
12578 chi1=chi(itypi,itypj)
12579 chi2=chi(itypj,itypi)
12586 alf12=0.5D0*(alf1+alf2)
12590 dxj=dc_norm(1,nres+j)
12591 dyj=dc_norm(2,nres+j)
12592 dzj=dc_norm(3,nres+j)
12593 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12595 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12597 if (sss.lt.1.0d0) then
12599 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12601 ! Calculate whole angle-dependent part of epsilon and contributions
12602 ! to its derivatives
12603 fac=(rrij*sigsq)**expon2
12604 e1=fac*fac*aa_aq(itypi,itypj)
12605 e2=fac*bb_aq(itypi,itypj)
12606 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12607 eps2der=evdwij*eps3rt
12608 eps3der=evdwij*eps2rt
12609 evdwij=evdwij*eps2rt*eps3rt
12610 evdw=evdw+evdwij*(1.0d0-sss)
12612 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12613 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12614 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12615 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12616 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12617 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12618 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12621 ! Calculate gradient components.
12622 e1=e1*eps1*eps2rt**2*eps3rt**2
12623 fac=-expon*(e1+evdwij)
12626 ! Calculate radial part of the gradient
12630 ! Calculate the angular part of the gradient and sum add the contributions
12631 ! to the appropriate components of the Cartesian gradient.
12632 call sc_grad_scale(1.0d0-sss)
12639 end subroutine ebp_long
12640 !-----------------------------------------------------------------------------
12641 subroutine ebp_short(evdw)
12643 ! This subroutine calculates the interaction energy of nonbonded side chains
12644 ! assuming the Berne-Pechukas potential of interaction.
12647 ! implicit real*8 (a-h,o-z)
12648 ! include 'DIMENSIONS'
12649 ! include 'COMMON.GEO'
12650 ! include 'COMMON.VAR'
12651 ! include 'COMMON.LOCAL'
12652 ! include 'COMMON.CHAIN'
12653 ! include 'COMMON.DERIV'
12654 ! include 'COMMON.NAMES'
12655 ! include 'COMMON.INTERACT'
12656 ! include 'COMMON.IOUNITS'
12657 ! include 'COMMON.CALC'
12659 !el integer :: icall
12660 !el common /srutu/ icall
12661 ! double precision rrsave(maxdim)
12663 !el local variables
12664 integer :: iint,itypi,itypi1,itypj
12665 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12666 real(kind=8) :: sss,e1,e2,evdw
12668 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12670 ! if (icall.eq.0) then
12676 do i=iatsc_s,iatsc_e
12678 if (itypi.eq.ntyp1) cycle
12679 itypi1=itype(i+1,1)
12683 dxi=dc_norm(1,nres+i)
12684 dyi=dc_norm(2,nres+i)
12685 dzi=dc_norm(3,nres+i)
12686 ! dsci_inv=dsc_inv(itypi)
12687 dsci_inv=vbld_inv(i+nres)
12689 ! Calculate SC interaction energy.
12691 do iint=1,nint_gr(i)
12692 do j=istart(i,iint),iend(i,iint)
12695 if (itypj.eq.ntyp1) cycle
12696 ! dscj_inv=dsc_inv(itypj)
12697 dscj_inv=vbld_inv(j+nres)
12698 chi1=chi(itypi,itypj)
12699 chi2=chi(itypj,itypi)
12706 alf12=0.5D0*(alf1+alf2)
12710 dxj=dc_norm(1,nres+j)
12711 dyj=dc_norm(2,nres+j)
12712 dzj=dc_norm(3,nres+j)
12713 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12715 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12717 if (sss.gt.0.0d0) then
12719 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12721 ! Calculate whole angle-dependent part of epsilon and contributions
12722 ! to its derivatives
12723 fac=(rrij*sigsq)**expon2
12724 e1=fac*fac*aa_aq(itypi,itypj)
12725 e2=fac*bb_aq(itypi,itypj)
12726 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12727 eps2der=evdwij*eps3rt
12728 eps3der=evdwij*eps2rt
12729 evdwij=evdwij*eps2rt*eps3rt
12730 evdw=evdw+evdwij*sss
12732 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12733 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12734 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12735 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12736 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12737 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12738 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12741 ! Calculate gradient components.
12742 e1=e1*eps1*eps2rt**2*eps3rt**2
12743 fac=-expon*(e1+evdwij)
12746 ! Calculate radial part of the gradient
12750 ! Calculate the angular part of the gradient and sum add the contributions
12751 ! to the appropriate components of the Cartesian gradient.
12752 call sc_grad_scale(sss)
12759 end subroutine ebp_short
12760 !-----------------------------------------------------------------------------
12761 subroutine egb_long(evdw)
12763 ! This subroutine calculates the interaction energy of nonbonded side chains
12764 ! assuming the Gay-Berne potential of interaction.
12767 ! implicit real*8 (a-h,o-z)
12768 ! include 'DIMENSIONS'
12769 ! include 'COMMON.GEO'
12770 ! include 'COMMON.VAR'
12771 ! include 'COMMON.LOCAL'
12772 ! include 'COMMON.CHAIN'
12773 ! include 'COMMON.DERIV'
12774 ! include 'COMMON.NAMES'
12775 ! include 'COMMON.INTERACT'
12776 ! include 'COMMON.IOUNITS'
12777 ! include 'COMMON.CALC'
12778 ! include 'COMMON.CONTROL'
12780 !el local variables
12781 integer :: iint,itypi,itypi1,itypj,subchap
12782 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
12783 real(kind=8) :: sss,e1,e2,evdw,sss_grad
12784 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12785 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12786 ssgradlipi,ssgradlipj
12790 !cccc energy_dec=.false.
12791 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12794 ! if (icall.eq.0) lprn=.false.
12796 do i=iatsc_s,iatsc_e
12798 if (itypi.eq.ntyp1) cycle
12799 itypi1=itype(i+1,1)
12803 xi=mod(xi,boxxsize)
12804 if (xi.lt.0) xi=xi+boxxsize
12805 yi=mod(yi,boxysize)
12806 if (yi.lt.0) yi=yi+boxysize
12807 zi=mod(zi,boxzsize)
12808 if (zi.lt.0) zi=zi+boxzsize
12809 if ((zi.gt.bordlipbot) &
12810 .and.(zi.lt.bordliptop)) then
12811 !C the energy transfer exist
12812 if (zi.lt.buflipbot) then
12813 !C what fraction I am in
12815 ((zi-bordlipbot)/lipbufthick)
12816 !C lipbufthick is thickenes of lipid buffore
12817 sslipi=sscalelip(fracinbuf)
12818 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12819 elseif (zi.gt.bufliptop) then
12820 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12821 sslipi=sscalelip(fracinbuf)
12822 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12832 dxi=dc_norm(1,nres+i)
12833 dyi=dc_norm(2,nres+i)
12834 dzi=dc_norm(3,nres+i)
12835 ! dsci_inv=dsc_inv(itypi)
12836 dsci_inv=vbld_inv(i+nres)
12837 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12838 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12840 ! Calculate SC interaction energy.
12842 do iint=1,nint_gr(i)
12843 do j=istart(i,iint),iend(i,iint)
12844 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12845 ! call dyn_ssbond_ene(i,j,evdwij)
12847 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12848 ! 'evdw',i,j,evdwij,' ss'
12849 ! if (energy_dec) write (iout,*) &
12850 ! 'evdw',i,j,evdwij,' ss'
12851 ! do k=j+1,iend(i,iint)
12852 !C search over all next residues
12853 ! if (dyn_ss_mask(k)) then
12854 !C check if they are cysteins
12855 !C write(iout,*) 'k=',k
12857 !c write(iout,*) "PRZED TRI", evdwij
12858 ! evdwij_przed_tri=evdwij
12859 ! call triple_ssbond_ene(i,j,k,evdwij)
12860 !c if(evdwij_przed_tri.ne.evdwij) then
12861 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
12864 !c write(iout,*) "PO TRI", evdwij
12865 !C call the energy function that removes the artifical triple disulfide
12866 !C bond the soubroutine is located in ssMD.F
12868 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12869 'evdw',i,j,evdwij,'tss'
12870 ! endif!dyn_ss_mask(k)
12876 if (itypj.eq.ntyp1) cycle
12877 ! dscj_inv=dsc_inv(itypj)
12878 dscj_inv=vbld_inv(j+nres)
12879 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
12880 ! & 1.0d0/vbld(j+nres)
12881 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
12882 sig0ij=sigma(itypi,itypj)
12883 chi1=chi(itypi,itypj)
12884 chi2=chi(itypj,itypi)
12891 alf12=0.5D0*(alf1+alf2)
12895 ! Searching for nearest neighbour
12896 xj=mod(xj,boxxsize)
12897 if (xj.lt.0) xj=xj+boxxsize
12898 yj=mod(yj,boxysize)
12899 if (yj.lt.0) yj=yj+boxysize
12900 zj=mod(zj,boxzsize)
12901 if (zj.lt.0) zj=zj+boxzsize
12902 if ((zj.gt.bordlipbot) &
12903 .and.(zj.lt.bordliptop)) then
12904 !C the energy transfer exist
12905 if (zj.lt.buflipbot) then
12906 !C what fraction I am in
12908 ((zj-bordlipbot)/lipbufthick)
12909 !C lipbufthick is thickenes of lipid buffore
12910 sslipj=sscalelip(fracinbuf)
12911 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
12912 elseif (zj.gt.bufliptop) then
12913 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
12914 sslipj=sscalelip(fracinbuf)
12915 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
12924 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12925 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12926 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
12927 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
12929 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12937 xj=xj_safe+xshift*boxxsize
12938 yj=yj_safe+yshift*boxysize
12939 zj=zj_safe+zshift*boxzsize
12940 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
12941 if(dist_temp.lt.dist_init) then
12942 dist_init=dist_temp
12951 if (subchap.eq.1) then
12961 dxj=dc_norm(1,nres+j)
12962 dyj=dc_norm(2,nres+j)
12963 dzj=dc_norm(3,nres+j)
12964 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12966 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12967 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
12968 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
12969 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
12970 if (sss_ele_cut.le.0.0) cycle
12971 if (sss.lt.1.0d0) then
12973 ! Calculate angle-dependent terms of energy and contributions to their
12977 sig=sig0ij*dsqrt(sigsq)
12978 rij_shift=1.0D0/rij-sig+sig0ij
12979 ! for diagnostics; uncomment
12980 ! rij_shift=1.2*sig0ij
12981 ! I hate to put IF's in the loops, but here don't have another choice!!!!
12982 if (rij_shift.le.0.0D0) then
12984 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
12985 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12986 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
12990 !---------------------------------------------------------------
12991 rij_shift=1.0D0/rij_shift
12992 fac=rij_shift**expon
12995 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12996 eps2der=evdwij*eps3rt
12997 eps3der=evdwij*eps2rt
12998 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
12999 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13000 evdwij=evdwij*eps2rt*eps3rt
13001 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13003 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13004 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13005 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13006 restyp(itypi,1),i,restyp(itypj,1),j,&
13007 epsi,sigm,chi1,chi2,chip1,chip2,&
13008 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13009 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13013 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13015 ! if (energy_dec) write (iout,*) &
13016 ! 'evdw',i,j,evdwij,"egb_long"
13018 ! Calculate gradient components.
13019 e1=e1*eps1*eps2rt**2*eps3rt**2
13020 fac=-expon*(e1+evdwij)*rij_shift
13023 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13024 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13025 /sigmaii(itypi,itypj))
13027 ! Calculate the radial part of the gradient
13031 ! Calculate angular part of the gradient.
13032 call sc_grad_scale(1.0d0-sss)
13038 ! write (iout,*) "Number of loop steps in EGB:",ind
13039 !ccc energy_dec=.false.
13041 end subroutine egb_long
13042 !-----------------------------------------------------------------------------
13043 subroutine egb_short(evdw)
13045 ! This subroutine calculates the interaction energy of nonbonded side chains
13046 ! assuming the Gay-Berne potential of interaction.
13049 ! implicit real*8 (a-h,o-z)
13050 ! include 'DIMENSIONS'
13051 ! include 'COMMON.GEO'
13052 ! include 'COMMON.VAR'
13053 ! include 'COMMON.LOCAL'
13054 ! include 'COMMON.CHAIN'
13055 ! include 'COMMON.DERIV'
13056 ! include 'COMMON.NAMES'
13057 ! include 'COMMON.INTERACT'
13058 ! include 'COMMON.IOUNITS'
13059 ! include 'COMMON.CALC'
13060 ! include 'COMMON.CONTROL'
13062 !el local variables
13063 integer :: iint,itypi,itypi1,itypj,subchap
13064 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13065 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13066 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13067 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13068 ssgradlipi,ssgradlipj
13070 !cccc energy_dec=.false.
13071 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13074 ! if (icall.eq.0) lprn=.false.
13076 do i=iatsc_s,iatsc_e
13078 if (itypi.eq.ntyp1) cycle
13079 itypi1=itype(i+1,1)
13083 xi=mod(xi,boxxsize)
13084 if (xi.lt.0) xi=xi+boxxsize
13085 yi=mod(yi,boxysize)
13086 if (yi.lt.0) yi=yi+boxysize
13087 zi=mod(zi,boxzsize)
13088 if (zi.lt.0) zi=zi+boxzsize
13089 if ((zi.gt.bordlipbot) &
13090 .and.(zi.lt.bordliptop)) then
13091 !C the energy transfer exist
13092 if (zi.lt.buflipbot) then
13093 !C what fraction I am in
13095 ((zi-bordlipbot)/lipbufthick)
13096 !C lipbufthick is thickenes of lipid buffore
13097 sslipi=sscalelip(fracinbuf)
13098 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13099 elseif (zi.gt.bufliptop) then
13100 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13101 sslipi=sscalelip(fracinbuf)
13102 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13112 dxi=dc_norm(1,nres+i)
13113 dyi=dc_norm(2,nres+i)
13114 dzi=dc_norm(3,nres+i)
13115 ! dsci_inv=dsc_inv(itypi)
13116 dsci_inv=vbld_inv(i+nres)
13118 dxi=dc_norm(1,nres+i)
13119 dyi=dc_norm(2,nres+i)
13120 dzi=dc_norm(3,nres+i)
13121 ! dsci_inv=dsc_inv(itypi)
13122 dsci_inv=vbld_inv(i+nres)
13123 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13124 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13126 ! Calculate SC interaction energy.
13128 do iint=1,nint_gr(i)
13129 do j=istart(i,iint),iend(i,iint)
13130 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13131 call dyn_ssbond_ene(i,j,evdwij)
13133 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13134 'evdw',i,j,evdwij,' ss'
13135 do k=j+1,iend(i,iint)
13136 !C search over all next residues
13137 if (dyn_ss_mask(k)) then
13138 !C check if they are cysteins
13139 !C write(iout,*) 'k=',k
13141 !c write(iout,*) "PRZED TRI", evdwij
13142 ! evdwij_przed_tri=evdwij
13143 call triple_ssbond_ene(i,j,k,evdwij)
13144 !c if(evdwij_przed_tri.ne.evdwij) then
13145 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13148 !c write(iout,*) "PO TRI", evdwij
13149 !C call the energy function that removes the artifical triple disulfide
13150 !C bond the soubroutine is located in ssMD.F
13152 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13153 'evdw',i,j,evdwij,'tss'
13154 endif!dyn_ss_mask(k)
13157 ! if (energy_dec) write (iout,*) &
13158 ! 'evdw',i,j,evdwij,' ss'
13162 if (itypj.eq.ntyp1) cycle
13163 ! dscj_inv=dsc_inv(itypj)
13164 dscj_inv=vbld_inv(j+nres)
13165 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13166 ! & 1.0d0/vbld(j+nres)
13167 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13168 sig0ij=sigma(itypi,itypj)
13169 chi1=chi(itypi,itypj)
13170 chi2=chi(itypj,itypi)
13177 alf12=0.5D0*(alf1+alf2)
13178 ! xj=c(1,nres+j)-xi
13179 ! yj=c(2,nres+j)-yi
13180 ! zj=c(3,nres+j)-zi
13184 ! Searching for nearest neighbour
13185 xj=mod(xj,boxxsize)
13186 if (xj.lt.0) xj=xj+boxxsize
13187 yj=mod(yj,boxysize)
13188 if (yj.lt.0) yj=yj+boxysize
13189 zj=mod(zj,boxzsize)
13190 if (zj.lt.0) zj=zj+boxzsize
13191 if ((zj.gt.bordlipbot) &
13192 .and.(zj.lt.bordliptop)) then
13193 !C the energy transfer exist
13194 if (zj.lt.buflipbot) then
13195 !C what fraction I am in
13197 ((zj-bordlipbot)/lipbufthick)
13198 !C lipbufthick is thickenes of lipid buffore
13199 sslipj=sscalelip(fracinbuf)
13200 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13201 elseif (zj.gt.bufliptop) then
13202 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13203 sslipj=sscalelip(fracinbuf)
13204 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13213 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13214 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13215 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13216 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13218 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13227 xj=xj_safe+xshift*boxxsize
13228 yj=yj_safe+yshift*boxysize
13229 zj=zj_safe+zshift*boxzsize
13230 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13231 if(dist_temp.lt.dist_init) then
13232 dist_init=dist_temp
13241 if (subchap.eq.1) then
13251 dxj=dc_norm(1,nres+j)
13252 dyj=dc_norm(2,nres+j)
13253 dzj=dc_norm(3,nres+j)
13254 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13256 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13257 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13258 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13259 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13260 if (sss_ele_cut.le.0.0) cycle
13262 if (sss.gt.0.0d0) then
13264 ! Calculate angle-dependent terms of energy and contributions to their
13268 sig=sig0ij*dsqrt(sigsq)
13269 rij_shift=1.0D0/rij-sig+sig0ij
13270 ! for diagnostics; uncomment
13271 ! rij_shift=1.2*sig0ij
13272 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13273 if (rij_shift.le.0.0D0) then
13275 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13276 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13277 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13281 !---------------------------------------------------------------
13282 rij_shift=1.0D0/rij_shift
13283 fac=rij_shift**expon
13286 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13287 eps2der=evdwij*eps3rt
13288 eps3der=evdwij*eps2rt
13289 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13290 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13291 evdwij=evdwij*eps2rt*eps3rt
13292 evdw=evdw+evdwij*sss*sss_ele_cut
13294 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13295 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13296 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13297 restyp(itypi,1),i,restyp(itypj,1),j,&
13298 epsi,sigm,chi1,chi2,chip1,chip2,&
13299 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13300 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13304 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13306 ! if (energy_dec) write (iout,*) &
13307 ! 'evdw',i,j,evdwij,"egb_short"
13309 ! Calculate gradient components.
13310 e1=e1*eps1*eps2rt**2*eps3rt**2
13311 fac=-expon*(e1+evdwij)*rij_shift
13314 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13315 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13316 /sigmaii(itypi,itypj))
13319 ! Calculate the radial part of the gradient
13323 ! Calculate angular part of the gradient.
13324 call sc_grad_scale(sss)
13330 ! write (iout,*) "Number of loop steps in EGB:",ind
13331 !ccc energy_dec=.false.
13333 end subroutine egb_short
13334 !-----------------------------------------------------------------------------
13335 subroutine egbv_long(evdw)
13337 ! This subroutine calculates the interaction energy of nonbonded side chains
13338 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13341 ! implicit real*8 (a-h,o-z)
13342 ! include 'DIMENSIONS'
13343 ! include 'COMMON.GEO'
13344 ! include 'COMMON.VAR'
13345 ! include 'COMMON.LOCAL'
13346 ! include 'COMMON.CHAIN'
13347 ! include 'COMMON.DERIV'
13348 ! include 'COMMON.NAMES'
13349 ! include 'COMMON.INTERACT'
13350 ! include 'COMMON.IOUNITS'
13351 ! include 'COMMON.CALC'
13353 !el integer :: icall
13354 !el common /srutu/ icall
13356 !el local variables
13357 integer :: iint,itypi,itypi1,itypj
13358 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13359 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13361 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13364 ! if (icall.eq.0) lprn=.true.
13366 do i=iatsc_s,iatsc_e
13368 if (itypi.eq.ntyp1) cycle
13369 itypi1=itype(i+1,1)
13373 dxi=dc_norm(1,nres+i)
13374 dyi=dc_norm(2,nres+i)
13375 dzi=dc_norm(3,nres+i)
13376 ! dsci_inv=dsc_inv(itypi)
13377 dsci_inv=vbld_inv(i+nres)
13379 ! Calculate SC interaction energy.
13381 do iint=1,nint_gr(i)
13382 do j=istart(i,iint),iend(i,iint)
13385 if (itypj.eq.ntyp1) cycle
13386 ! dscj_inv=dsc_inv(itypj)
13387 dscj_inv=vbld_inv(j+nres)
13388 sig0ij=sigma(itypi,itypj)
13389 r0ij=r0(itypi,itypj)
13390 chi1=chi(itypi,itypj)
13391 chi2=chi(itypj,itypi)
13398 alf12=0.5D0*(alf1+alf2)
13402 dxj=dc_norm(1,nres+j)
13403 dyj=dc_norm(2,nres+j)
13404 dzj=dc_norm(3,nres+j)
13405 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13408 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13410 if (sss.lt.1.0d0) then
13412 ! Calculate angle-dependent terms of energy and contributions to their
13416 sig=sig0ij*dsqrt(sigsq)
13417 rij_shift=1.0D0/rij-sig+r0ij
13418 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13419 if (rij_shift.le.0.0D0) then
13424 !---------------------------------------------------------------
13425 rij_shift=1.0D0/rij_shift
13426 fac=rij_shift**expon
13427 e1=fac*fac*aa_aq(itypi,itypj)
13428 e2=fac*bb_aq(itypi,itypj)
13429 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13430 eps2der=evdwij*eps3rt
13431 eps3der=evdwij*eps2rt
13432 fac_augm=rrij**expon
13433 e_augm=augm(itypi,itypj)*fac_augm
13434 evdwij=evdwij*eps2rt*eps3rt
13435 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13437 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13438 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13439 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13440 restyp(itypi,1),i,restyp(itypj,1),j,&
13441 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13442 chi1,chi2,chip1,chip2,&
13443 eps1,eps2rt**2,eps3rt**2,&
13444 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13447 ! Calculate gradient components.
13448 e1=e1*eps1*eps2rt**2*eps3rt**2
13449 fac=-expon*(e1+evdwij)*rij_shift
13451 fac=rij*fac-2*expon*rrij*e_augm
13452 ! Calculate the radial part of the gradient
13456 ! Calculate angular part of the gradient.
13457 call sc_grad_scale(1.0d0-sss)
13462 end subroutine egbv_long
13463 !-----------------------------------------------------------------------------
13464 subroutine egbv_short(evdw)
13466 ! This subroutine calculates the interaction energy of nonbonded side chains
13467 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13470 ! implicit real*8 (a-h,o-z)
13471 ! include 'DIMENSIONS'
13472 ! include 'COMMON.GEO'
13473 ! include 'COMMON.VAR'
13474 ! include 'COMMON.LOCAL'
13475 ! include 'COMMON.CHAIN'
13476 ! include 'COMMON.DERIV'
13477 ! include 'COMMON.NAMES'
13478 ! include 'COMMON.INTERACT'
13479 ! include 'COMMON.IOUNITS'
13480 ! include 'COMMON.CALC'
13482 !el integer :: icall
13483 !el common /srutu/ icall
13485 !el local variables
13486 integer :: iint,itypi,itypi1,itypj
13487 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13488 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13490 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13493 ! if (icall.eq.0) lprn=.true.
13495 do i=iatsc_s,iatsc_e
13497 if (itypi.eq.ntyp1) cycle
13498 itypi1=itype(i+1,1)
13502 dxi=dc_norm(1,nres+i)
13503 dyi=dc_norm(2,nres+i)
13504 dzi=dc_norm(3,nres+i)
13505 ! dsci_inv=dsc_inv(itypi)
13506 dsci_inv=vbld_inv(i+nres)
13508 ! Calculate SC interaction energy.
13510 do iint=1,nint_gr(i)
13511 do j=istart(i,iint),iend(i,iint)
13514 if (itypj.eq.ntyp1) cycle
13515 ! dscj_inv=dsc_inv(itypj)
13516 dscj_inv=vbld_inv(j+nres)
13517 sig0ij=sigma(itypi,itypj)
13518 r0ij=r0(itypi,itypj)
13519 chi1=chi(itypi,itypj)
13520 chi2=chi(itypj,itypi)
13527 alf12=0.5D0*(alf1+alf2)
13531 dxj=dc_norm(1,nres+j)
13532 dyj=dc_norm(2,nres+j)
13533 dzj=dc_norm(3,nres+j)
13534 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13537 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13539 if (sss.gt.0.0d0) then
13541 ! Calculate angle-dependent terms of energy and contributions to their
13545 sig=sig0ij*dsqrt(sigsq)
13546 rij_shift=1.0D0/rij-sig+r0ij
13547 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13548 if (rij_shift.le.0.0D0) then
13553 !---------------------------------------------------------------
13554 rij_shift=1.0D0/rij_shift
13555 fac=rij_shift**expon
13556 e1=fac*fac*aa_aq(itypi,itypj)
13557 e2=fac*bb_aq(itypi,itypj)
13558 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13559 eps2der=evdwij*eps3rt
13560 eps3der=evdwij*eps2rt
13561 fac_augm=rrij**expon
13562 e_augm=augm(itypi,itypj)*fac_augm
13563 evdwij=evdwij*eps2rt*eps3rt
13564 evdw=evdw+(evdwij+e_augm)*sss
13566 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13567 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13568 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13569 restyp(itypi,1),i,restyp(itypj,1),j,&
13570 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13571 chi1,chi2,chip1,chip2,&
13572 eps1,eps2rt**2,eps3rt**2,&
13573 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13576 ! Calculate gradient components.
13577 e1=e1*eps1*eps2rt**2*eps3rt**2
13578 fac=-expon*(e1+evdwij)*rij_shift
13580 fac=rij*fac-2*expon*rrij*e_augm
13581 ! Calculate the radial part of the gradient
13585 ! Calculate angular part of the gradient.
13586 call sc_grad_scale(sss)
13591 end subroutine egbv_short
13592 !-----------------------------------------------------------------------------
13593 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13595 ! This subroutine calculates the average interaction energy and its gradient
13596 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13597 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13598 ! The potential depends both on the distance of peptide-group centers and on
13599 ! the orientation of the CA-CA virtual bonds.
13601 ! implicit real*8 (a-h,o-z)
13607 ! include 'DIMENSIONS'
13608 ! include 'COMMON.CONTROL'
13609 ! include 'COMMON.SETUP'
13610 ! include 'COMMON.IOUNITS'
13611 ! include 'COMMON.GEO'
13612 ! include 'COMMON.VAR'
13613 ! include 'COMMON.LOCAL'
13614 ! include 'COMMON.CHAIN'
13615 ! include 'COMMON.DERIV'
13616 ! include 'COMMON.INTERACT'
13617 ! include 'COMMON.CONTACTS'
13618 ! include 'COMMON.TORSION'
13619 ! include 'COMMON.VECTORS'
13620 ! include 'COMMON.FFIELD'
13621 ! include 'COMMON.TIME1'
13622 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13623 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13624 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13625 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13626 real(kind=8),dimension(4) :: muij
13627 !el integer :: num_conti,j1,j2
13628 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13629 !el dz_normi,xmedi,ymedi,zmedi
13630 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13631 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13632 !el num_conti,j1,j2
13633 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13635 real(kind=8) :: scal_el=1.0d0
13637 real(kind=8) :: scal_el=0.5d0
13640 ! 13-go grudnia roku pamietnego...
13641 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13642 0.0d0,1.0d0,0.0d0,&
13643 0.0d0,0.0d0,1.0d0/),shape(unmat))
13644 !el local variables
13646 real(kind=8) :: fac
13647 real(kind=8) :: dxj,dyj,dzj
13648 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13650 ! allocate(num_cont_hb(nres)) !(maxres)
13651 !d write(iout,*) 'In EELEC'
13653 !d write(iout,*) 'Type',i
13654 !d write(iout,*) 'B1',B1(:,i)
13655 !d write(iout,*) 'B2',B2(:,i)
13656 !d write(iout,*) 'CC',CC(:,:,i)
13657 !d write(iout,*) 'DD',DD(:,:,i)
13658 !d write(iout,*) 'EE',EE(:,:,i)
13660 !d call check_vecgrad
13662 if (icheckgrad.eq.1) then
13664 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13666 dc_norm(k,i)=dc(k,i)*fac
13668 ! write (iout,*) 'i',i,' fac',fac
13671 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13672 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13673 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13674 ! call vec_and_deriv
13678 ! print *, "before set matrices"
13680 ! print *,"after set martices"
13682 time_mat=time_mat+MPI_Wtime()-time01
13686 !d write (iout,*) 'i=',i
13688 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13691 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13692 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
13705 !d print '(a)','Enter EELEC'
13706 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
13707 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13708 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13710 gel_loc_loc(i)=0.0d0
13715 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
13717 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
13719 do i=iturn3_start,iturn3_end
13720 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
13721 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
13725 dx_normi=dc_norm(1,i)
13726 dy_normi=dc_norm(2,i)
13727 dz_normi=dc_norm(3,i)
13728 xmedi=c(1,i)+0.5d0*dxi
13729 ymedi=c(2,i)+0.5d0*dyi
13730 zmedi=c(3,i)+0.5d0*dzi
13731 xmedi=dmod(xmedi,boxxsize)
13732 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13733 ymedi=dmod(ymedi,boxysize)
13734 if (ymedi.lt.0) ymedi=ymedi+boxysize
13735 zmedi=dmod(zmedi,boxzsize)
13736 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13738 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
13739 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
13740 num_cont_hb(i)=num_conti
13742 do i=iturn4_start,iturn4_end
13743 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
13744 .or. itype(i+3,1).eq.ntyp1 &
13745 .or. itype(i+4,1).eq.ntyp1) cycle
13749 dx_normi=dc_norm(1,i)
13750 dy_normi=dc_norm(2,i)
13751 dz_normi=dc_norm(3,i)
13752 xmedi=c(1,i)+0.5d0*dxi
13753 ymedi=c(2,i)+0.5d0*dyi
13754 zmedi=c(3,i)+0.5d0*dzi
13755 xmedi=dmod(xmedi,boxxsize)
13756 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13757 ymedi=dmod(ymedi,boxysize)
13758 if (ymedi.lt.0) ymedi=ymedi+boxysize
13759 zmedi=dmod(zmedi,boxzsize)
13760 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13761 num_conti=num_cont_hb(i)
13762 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
13763 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
13764 call eturn4(i,eello_turn4)
13765 num_cont_hb(i)=num_conti
13768 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
13770 do i=iatel_s,iatel_e
13771 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
13775 dx_normi=dc_norm(1,i)
13776 dy_normi=dc_norm(2,i)
13777 dz_normi=dc_norm(3,i)
13778 xmedi=c(1,i)+0.5d0*dxi
13779 ymedi=c(2,i)+0.5d0*dyi
13780 zmedi=c(3,i)+0.5d0*dzi
13781 xmedi=dmod(xmedi,boxxsize)
13782 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13783 ymedi=dmod(ymedi,boxysize)
13784 if (ymedi.lt.0) ymedi=ymedi+boxysize
13785 zmedi=dmod(zmedi,boxzsize)
13786 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13787 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
13788 num_conti=num_cont_hb(i)
13789 do j=ielstart(i),ielend(i)
13790 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
13791 call eelecij_scale(i,j,ees,evdw1,eel_loc)
13793 num_cont_hb(i)=num_conti
13795 ! write (iout,*) "Number of loop steps in EELEC:",ind
13797 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
13798 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
13800 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
13801 !cc eel_loc=eel_loc+eello_turn3
13802 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
13804 end subroutine eelec_scale
13805 !-----------------------------------------------------------------------------
13806 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
13807 ! implicit real*8 (a-h,o-z)
13810 ! include 'DIMENSIONS'
13814 ! include 'COMMON.CONTROL'
13815 ! include 'COMMON.IOUNITS'
13816 ! include 'COMMON.GEO'
13817 ! include 'COMMON.VAR'
13818 ! include 'COMMON.LOCAL'
13819 ! include 'COMMON.CHAIN'
13820 ! include 'COMMON.DERIV'
13821 ! include 'COMMON.INTERACT'
13822 ! include 'COMMON.CONTACTS'
13823 ! include 'COMMON.TORSION'
13824 ! include 'COMMON.VECTORS'
13825 ! include 'COMMON.FFIELD'
13826 ! include 'COMMON.TIME1'
13827 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
13828 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
13829 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13830 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13831 real(kind=8),dimension(4) :: muij
13832 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13833 dist_temp, dist_init,sss_grad
13834 integer xshift,yshift,zshift
13836 !el integer :: num_conti,j1,j2
13837 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13838 !el dz_normi,xmedi,ymedi,zmedi
13839 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13840 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13841 !el num_conti,j1,j2
13842 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13844 real(kind=8) :: scal_el=1.0d0
13846 real(kind=8) :: scal_el=0.5d0
13849 ! 13-go grudnia roku pamietnego...
13850 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13851 0.0d0,1.0d0,0.0d0,&
13852 0.0d0,0.0d0,1.0d0/),shape(unmat))
13853 !el local variables
13854 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
13855 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
13856 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
13857 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
13858 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
13859 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
13860 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
13861 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
13862 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
13863 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
13864 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
13865 ecosam,ecosbm,ecosgm,ghalf,time00
13866 ! integer :: maxconts
13867 ! maxconts = nres/4
13868 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13869 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13870 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13871 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13872 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13873 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13874 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13875 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13876 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
13877 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
13878 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
13879 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
13880 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
13882 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
13883 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
13888 !d write (iout,*) "eelecij",i,j
13892 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
13893 aaa=app(iteli,itelj)
13894 bbb=bpp(iteli,itelj)
13895 ael6i=ael6(iteli,itelj)
13896 ael3i=ael3(iteli,itelj)
13900 dx_normj=dc_norm(1,j)
13901 dy_normj=dc_norm(2,j)
13902 dz_normj=dc_norm(3,j)
13903 ! xj=c(1,j)+0.5D0*dxj-xmedi
13904 ! yj=c(2,j)+0.5D0*dyj-ymedi
13905 ! zj=c(3,j)+0.5D0*dzj-zmedi
13906 xj=c(1,j)+0.5D0*dxj
13907 yj=c(2,j)+0.5D0*dyj
13908 zj=c(3,j)+0.5D0*dzj
13909 xj=mod(xj,boxxsize)
13910 if (xj.lt.0) xj=xj+boxxsize
13911 yj=mod(yj,boxysize)
13912 if (yj.lt.0) yj=yj+boxysize
13913 zj=mod(zj,boxzsize)
13914 if (zj.lt.0) zj=zj+boxzsize
13916 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13923 xj=xj_safe+xshift*boxxsize
13924 yj=yj_safe+yshift*boxysize
13925 zj=zj_safe+zshift*boxzsize
13926 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
13927 if(dist_temp.lt.dist_init) then
13928 dist_init=dist_temp
13937 if (isubchap.eq.1) then
13948 rij=xj*xj+yj*yj+zj*zj
13952 ! For extracting the short-range part of Evdwpp
13953 sss=sscale(rij/rpp(iteli,itelj))
13954 sss_ele_cut=sscale_ele(rij)
13955 sss_ele_grad=sscagrad_ele(rij)
13956 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
13957 ! sss_ele_cut=1.0d0
13958 ! sss_ele_grad=0.0d0
13959 if (sss_ele_cut.le.0.0) go to 128
13963 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
13964 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
13965 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
13966 fac=cosa-3.0D0*cosb*cosg
13968 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
13969 if (j.eq.i+2) ev1=scal_el*ev1
13974 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
13977 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
13978 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
13979 ees=ees+eesij*sss_ele_cut
13980 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
13981 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
13982 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
13983 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
13984 !d & xmedi,ymedi,zmedi,xj,yj,zj
13986 if (energy_dec) then
13987 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
13988 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
13992 ! Calculate contributions to the Cartesian gradient.
13995 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
13996 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14002 ! Radial derivatives. First process both termini of the fragment (i,j)
14004 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14005 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14006 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14008 ! ghalf=0.5D0*ggg(k)
14009 ! gelc(k,i)=gelc(k,i)+ghalf
14010 ! gelc(k,j)=gelc(k,j)+ghalf
14012 ! 9/28/08 AL Gradient compotents will be summed only at the end
14014 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14015 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14018 ! Loop over residues i+1 thru j-1.
14022 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14025 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14026 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14027 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14028 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14029 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14030 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14032 ! ghalf=0.5D0*ggg(k)
14033 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14034 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14036 ! 9/28/08 AL Gradient compotents will be summed only at the end
14038 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14039 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14042 ! Loop over residues i+1 thru j-1.
14046 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14050 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14051 facel=(el1+eesij)*sss_ele_cut
14053 fac=-3*rrmij*(facvdw+facvdw+facel)
14058 ! Radial derivatives. First process both termini of the fragment (i,j)
14064 ! ghalf=0.5D0*ggg(k)
14065 ! gelc(k,i)=gelc(k,i)+ghalf
14066 ! gelc(k,j)=gelc(k,j)+ghalf
14068 ! 9/28/08 AL Gradient compotents will be summed only at the end
14070 gelc_long(k,j)=gelc(k,j)+ggg(k)
14071 gelc_long(k,i)=gelc(k,i)-ggg(k)
14074 ! Loop over residues i+1 thru j-1.
14078 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14081 ! 9/28/08 AL Gradient compotents will be summed only at the end
14086 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14087 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14093 ecosa=2.0D0*fac3*fac1+fac4
14096 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14097 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14099 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14100 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14102 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14103 !d & (dcosg(k),k=1,3)
14105 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14108 ! ghalf=0.5D0*ggg(k)
14109 ! gelc(k,i)=gelc(k,i)+ghalf
14110 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14111 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14112 ! gelc(k,j)=gelc(k,j)+ghalf
14113 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14114 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14118 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14122 gelc(k,i)=gelc(k,i) &
14123 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14124 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14126 gelc(k,j)=gelc(k,j) &
14127 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14128 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14130 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14131 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14133 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14134 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14135 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14137 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14138 ! energy of a peptide unit is assumed in the form of a second-order
14139 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14140 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14141 ! are computed for EVERY pair of non-contiguous peptide groups.
14143 if (j.lt.nres-1) then
14154 muij(kkk)=mu(k,i)*mu(l,j)
14157 !d write (iout,*) 'EELEC: i',i,' j',j
14158 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14159 !d write(iout,*) 'muij',muij
14160 ury=scalar(uy(1,i),erij)
14161 urz=scalar(uz(1,i),erij)
14162 vry=scalar(uy(1,j),erij)
14163 vrz=scalar(uz(1,j),erij)
14164 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14165 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14166 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14167 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14168 fac=dsqrt(-ael6i)*r3ij
14173 !d write (iout,'(4i5,4f10.5)')
14174 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14175 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14176 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14177 !d & uy(:,j),uz(:,j)
14178 !d write (iout,'(4f10.5)')
14179 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14180 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14181 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14182 !d write (iout,'(9f10.5/)')
14183 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14184 ! Derivatives of the elements of A in virtual-bond vectors
14185 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14187 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14188 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14189 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14190 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14191 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14192 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14193 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14194 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14195 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14196 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14197 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14198 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14200 ! Compute radial contributions to the gradient
14218 ! Add the contributions coming from er
14221 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14222 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14223 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14224 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14227 ! Derivatives in DC(i)
14228 !grad ghalf1=0.5d0*agg(k,1)
14229 !grad ghalf2=0.5d0*agg(k,2)
14230 !grad ghalf3=0.5d0*agg(k,3)
14231 !grad ghalf4=0.5d0*agg(k,4)
14232 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14233 -3.0d0*uryg(k,2)*vry)!+ghalf1
14234 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14235 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14236 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14237 -3.0d0*urzg(k,2)*vry)!+ghalf3
14238 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14239 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14240 ! Derivatives in DC(i+1)
14241 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14242 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14243 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14244 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14245 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14246 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14247 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14248 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14249 ! Derivatives in DC(j)
14250 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14251 -3.0d0*vryg(k,2)*ury)!+ghalf1
14252 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14253 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14254 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14255 -3.0d0*vryg(k,2)*urz)!+ghalf3
14256 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14257 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14258 ! Derivatives in DC(j+1) or DC(nres-1)
14259 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14260 -3.0d0*vryg(k,3)*ury)
14261 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14262 -3.0d0*vrzg(k,3)*ury)
14263 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14264 -3.0d0*vryg(k,3)*urz)
14265 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14266 -3.0d0*vrzg(k,3)*urz)
14267 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14269 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14282 aggi(k,l)=-aggi(k,l)
14283 aggi1(k,l)=-aggi1(k,l)
14284 aggj(k,l)=-aggj(k,l)
14285 aggj1(k,l)=-aggj1(k,l)
14288 if (j.lt.nres-1) then
14294 aggi(k,l)=-aggi(k,l)
14295 aggi1(k,l)=-aggi1(k,l)
14296 aggj(k,l)=-aggj(k,l)
14297 aggj1(k,l)=-aggj1(k,l)
14308 aggi(k,l)=-aggi(k,l)
14309 aggi1(k,l)=-aggi1(k,l)
14310 aggj(k,l)=-aggj(k,l)
14311 aggj1(k,l)=-aggj1(k,l)
14316 IF (wel_loc.gt.0.0d0) THEN
14317 ! Contribution to the local-electrostatic energy coming from the i-j pair
14318 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14320 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14322 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14323 'eelloc',i,j,eel_loc_ij
14324 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14326 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14327 ! Partial derivatives in virtual-bond dihedral angles gamma
14329 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14330 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14331 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14333 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14334 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14335 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14341 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14343 ggg(l)=(agg(l,1)*muij(1)+ &
14344 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14346 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14348 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14349 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14350 !grad ghalf=0.5d0*ggg(l)
14351 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14352 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14356 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14359 ! Remaining derivatives of eello
14361 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14362 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14365 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14366 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14369 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14370 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14373 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14374 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14379 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14380 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14381 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14382 .and. num_conti.le.maxconts) then
14383 ! write (iout,*) i,j," entered corr"
14385 ! Calculate the contact function. The ith column of the array JCONT will
14386 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14387 ! greater than I). The arrays FACONT and GACONT will contain the values of
14388 ! the contact function and its derivative.
14389 ! r0ij=1.02D0*rpp(iteli,itelj)
14390 ! r0ij=1.11D0*rpp(iteli,itelj)
14391 r0ij=2.20D0*rpp(iteli,itelj)
14392 ! r0ij=1.55D0*rpp(iteli,itelj)
14393 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14394 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14395 if (fcont.gt.0.0D0) then
14396 num_conti=num_conti+1
14397 if (num_conti.gt.maxconts) then
14398 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14399 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14400 ' will skip next contacts for this conf.',num_conti
14402 jcont_hb(num_conti,i)=j
14403 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14404 !d & " jcont_hb",jcont_hb(num_conti,i)
14405 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14406 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14407 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14409 d_cont(num_conti,i)=rij
14410 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14411 ! --- Electrostatic-interaction matrix ---
14412 a_chuj(1,1,num_conti,i)=a22
14413 a_chuj(1,2,num_conti,i)=a23
14414 a_chuj(2,1,num_conti,i)=a32
14415 a_chuj(2,2,num_conti,i)=a33
14416 ! --- Gradient of rij
14418 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14425 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14426 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14427 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14428 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14429 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14434 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14435 ! Calculate contact energies
14437 wij=cosa-3.0D0*cosb*cosg
14440 ! fac3=dsqrt(-ael6i)/r0ij**3
14441 fac3=dsqrt(-ael6i)*r3ij
14442 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14443 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14444 if (ees0tmp.gt.0) then
14445 ees0pij=dsqrt(ees0tmp)
14449 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14450 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14451 if (ees0tmp.gt.0) then
14452 ees0mij=dsqrt(ees0tmp)
14457 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14460 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14463 ! Diagnostics. Comment out or remove after debugging!
14464 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14465 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14466 ! ees0m(num_conti,i)=0.0D0
14468 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14469 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14470 ! Angular derivatives of the contact function
14471 ees0pij1=fac3/ees0pij
14472 ees0mij1=fac3/ees0mij
14473 fac3p=-3.0D0*fac3*rrmij
14474 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14475 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14477 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14478 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14479 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14480 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14481 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14482 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14483 ecosap=ecosa1+ecosa2
14484 ecosbp=ecosb1+ecosb2
14485 ecosgp=ecosg1+ecosg2
14486 ecosam=ecosa1-ecosa2
14487 ecosbm=ecosb1-ecosb2
14488 ecosgm=ecosg1-ecosg2
14497 facont_hb(num_conti,i)=fcont
14498 fprimcont=fprimcont/rij
14499 !d facont_hb(num_conti,i)=1.0D0
14500 ! Following line is for diagnostics.
14503 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14504 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14507 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14508 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14510 ! gggp(1)=gggp(1)+ees0pijp*xj
14511 ! gggp(2)=gggp(2)+ees0pijp*yj
14512 ! gggp(3)=gggp(3)+ees0pijp*zj
14513 ! gggm(1)=gggm(1)+ees0mijp*xj
14514 ! gggm(2)=gggm(2)+ees0mijp*yj
14515 ! gggm(3)=gggm(3)+ees0mijp*zj
14516 gggp(1)=gggp(1)+ees0pijp*xj &
14517 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14518 gggp(2)=gggp(2)+ees0pijp*yj &
14519 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14520 gggp(3)=gggp(3)+ees0pijp*zj &
14521 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14523 gggm(1)=gggm(1)+ees0mijp*xj &
14524 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14526 gggm(2)=gggm(2)+ees0mijp*yj &
14527 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14529 gggm(3)=gggm(3)+ees0mijp*zj &
14530 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14532 ! Derivatives due to the contact function
14533 gacont_hbr(1,num_conti,i)=fprimcont*xj
14534 gacont_hbr(2,num_conti,i)=fprimcont*yj
14535 gacont_hbr(3,num_conti,i)=fprimcont*zj
14538 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14539 ! following the change of gradient-summation algorithm.
14541 !grad ghalfp=0.5D0*gggp(k)
14542 !grad ghalfm=0.5D0*gggm(k)
14543 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14544 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14545 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14546 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14547 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14548 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14549 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14550 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14551 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14552 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14553 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14554 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14555 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14556 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14557 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14558 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14559 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14562 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14563 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14564 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14567 gacontp_hb3(k,num_conti,i)=gggp(k) &
14570 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14571 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14572 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14575 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14576 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14577 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14580 gacontm_hb3(k,num_conti,i)=gggm(k) &
14585 endif ! num_conti.le.maxconts
14588 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14591 ghalf=0.5d0*agg(l,k)
14592 aggi(l,k)=aggi(l,k)+ghalf
14593 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14594 aggj(l,k)=aggj(l,k)+ghalf
14597 if (j.eq.nres-1 .and. i.lt.j-2) then
14600 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14606 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14608 end subroutine eelecij_scale
14609 !-----------------------------------------------------------------------------
14610 subroutine evdwpp_short(evdw1)
14614 ! implicit real*8 (a-h,o-z)
14615 ! include 'DIMENSIONS'
14616 ! include 'COMMON.CONTROL'
14617 ! include 'COMMON.IOUNITS'
14618 ! include 'COMMON.GEO'
14619 ! include 'COMMON.VAR'
14620 ! include 'COMMON.LOCAL'
14621 ! include 'COMMON.CHAIN'
14622 ! include 'COMMON.DERIV'
14623 ! include 'COMMON.INTERACT'
14624 ! include 'COMMON.CONTACTS'
14625 ! include 'COMMON.TORSION'
14626 ! include 'COMMON.VECTORS'
14627 ! include 'COMMON.FFIELD'
14628 real(kind=8),dimension(3) :: ggg
14629 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14631 real(kind=8) :: scal_el=1.0d0
14633 real(kind=8) :: scal_el=0.5d0
14635 !el local variables
14636 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14637 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14638 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14639 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14640 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14641 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14642 dist_temp, dist_init,sss_grad
14643 integer xshift,yshift,zshift
14647 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14648 ! & " iatel_e_vdw",iatel_e_vdw
14650 do i=iatel_s_vdw,iatel_e_vdw
14651 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14655 dx_normi=dc_norm(1,i)
14656 dy_normi=dc_norm(2,i)
14657 dz_normi=dc_norm(3,i)
14658 xmedi=c(1,i)+0.5d0*dxi
14659 ymedi=c(2,i)+0.5d0*dyi
14660 zmedi=c(3,i)+0.5d0*dzi
14661 xmedi=dmod(xmedi,boxxsize)
14662 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14663 ymedi=dmod(ymedi,boxysize)
14664 if (ymedi.lt.0) ymedi=ymedi+boxysize
14665 zmedi=dmod(zmedi,boxzsize)
14666 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14668 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14669 ! & ' ielend',ielend_vdw(i)
14671 do j=ielstart_vdw(i),ielend_vdw(i)
14672 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14676 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14677 aaa=app(iteli,itelj)
14678 bbb=bpp(iteli,itelj)
14682 dx_normj=dc_norm(1,j)
14683 dy_normj=dc_norm(2,j)
14684 dz_normj=dc_norm(3,j)
14685 ! xj=c(1,j)+0.5D0*dxj-xmedi
14686 ! yj=c(2,j)+0.5D0*dyj-ymedi
14687 ! zj=c(3,j)+0.5D0*dzj-zmedi
14688 xj=c(1,j)+0.5D0*dxj
14689 yj=c(2,j)+0.5D0*dyj
14690 zj=c(3,j)+0.5D0*dzj
14691 xj=mod(xj,boxxsize)
14692 if (xj.lt.0) xj=xj+boxxsize
14693 yj=mod(yj,boxysize)
14694 if (yj.lt.0) yj=yj+boxysize
14695 zj=mod(zj,boxzsize)
14696 if (zj.lt.0) zj=zj+boxzsize
14698 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14705 xj=xj_safe+xshift*boxxsize
14706 yj=yj_safe+yshift*boxysize
14707 zj=zj_safe+zshift*boxzsize
14708 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14709 if(dist_temp.lt.dist_init) then
14710 dist_init=dist_temp
14719 if (isubchap.eq.1) then
14730 rij=xj*xj+yj*yj+zj*zj
14733 sss=sscale(rij/rpp(iteli,itelj))
14734 sss_ele_cut=sscale_ele(rij)
14735 sss_ele_grad=sscagrad_ele(rij)
14736 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14737 if (sss_ele_cut.le.0.0) cycle
14738 if (sss.gt.0.0d0) then
14743 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14744 if (j.eq.i+2) ev1=scal_el*ev1
14747 if (energy_dec) then
14748 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14750 evdw1=evdw1+evdwij*sss*sss_ele_cut
14752 ! Calculate contributions to the Cartesian gradient.
14754 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
14758 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
14759 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14760 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
14761 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14762 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
14763 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14766 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14767 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14773 end subroutine evdwpp_short
14774 !-----------------------------------------------------------------------------
14775 subroutine escp_long(evdw2,evdw2_14)
14777 ! This subroutine calculates the excluded-volume interaction energy between
14778 ! peptide-group centers and side chains and its gradient in virtual-bond and
14779 ! side-chain vectors.
14781 ! implicit real*8 (a-h,o-z)
14782 ! include 'DIMENSIONS'
14783 ! include 'COMMON.GEO'
14784 ! include 'COMMON.VAR'
14785 ! include 'COMMON.LOCAL'
14786 ! include 'COMMON.CHAIN'
14787 ! include 'COMMON.DERIV'
14788 ! include 'COMMON.INTERACT'
14789 ! include 'COMMON.FFIELD'
14790 ! include 'COMMON.IOUNITS'
14791 ! include 'COMMON.CONTROL'
14792 real(kind=8),dimension(3) :: ggg
14793 !el local variables
14794 integer :: i,iint,j,k,iteli,itypj,subchap
14795 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14796 real(kind=8) :: evdw2,evdw2_14,evdwij
14797 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14798 dist_temp, dist_init
14802 !d print '(a)','Enter ESCP'
14803 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14804 do i=iatscp_s,iatscp_e
14805 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14807 xi=0.5D0*(c(1,i)+c(1,i+1))
14808 yi=0.5D0*(c(2,i)+c(2,i+1))
14809 zi=0.5D0*(c(3,i)+c(3,i+1))
14810 xi=mod(xi,boxxsize)
14811 if (xi.lt.0) xi=xi+boxxsize
14812 yi=mod(yi,boxysize)
14813 if (yi.lt.0) yi=yi+boxysize
14814 zi=mod(zi,boxzsize)
14815 if (zi.lt.0) zi=zi+boxzsize
14817 do iint=1,nscp_gr(i)
14819 do j=iscpstart(i,iint),iscpend(i,iint)
14821 if (itypj.eq.ntyp1) cycle
14822 ! Uncomment following three lines for SC-p interactions
14823 ! xj=c(1,nres+j)-xi
14824 ! yj=c(2,nres+j)-yi
14825 ! zj=c(3,nres+j)-zi
14826 ! Uncomment following three lines for Ca-p interactions
14830 xj=mod(xj,boxxsize)
14831 if (xj.lt.0) xj=xj+boxxsize
14832 yj=mod(yj,boxysize)
14833 if (yj.lt.0) yj=yj+boxysize
14834 zj=mod(zj,boxzsize)
14835 if (zj.lt.0) zj=zj+boxzsize
14836 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14844 xj=xj_safe+xshift*boxxsize
14845 yj=yj_safe+yshift*boxysize
14846 zj=zj_safe+zshift*boxzsize
14847 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14848 if(dist_temp.lt.dist_init) then
14849 dist_init=dist_temp
14858 if (subchap.eq.1) then
14867 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14869 rij=dsqrt(1.0d0/rrij)
14870 sss_ele_cut=sscale_ele(rij)
14871 sss_ele_grad=sscagrad_ele(rij)
14872 ! print *,sss_ele_cut,sss_ele_grad,&
14873 ! (rij),r_cut_ele,rlamb_ele
14874 if (sss_ele_cut.le.0.0) cycle
14875 sss=sscale((rij/rscp(itypj,iteli)))
14876 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14877 if (sss.lt.1.0d0) then
14880 e1=fac*fac*aad(itypj,iteli)
14881 e2=fac*bad(itypj,iteli)
14882 if (iabs(j-i) .le. 2) then
14885 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
14888 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
14889 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
14890 'evdw2',i,j,sss,evdwij
14892 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
14894 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
14895 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
14896 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
14900 ! Uncomment following three lines for SC-p interactions
14902 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14904 ! Uncomment following line for SC-p interactions
14905 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
14907 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
14908 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
14917 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
14918 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
14919 gradx_scp(j,i)=expon*gradx_scp(j,i)
14922 !******************************************************************************
14926 ! To save time the factor EXPON has been extracted from ALL components
14927 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
14930 !******************************************************************************
14932 end subroutine escp_long
14933 !-----------------------------------------------------------------------------
14934 subroutine escp_short(evdw2,evdw2_14)
14936 ! This subroutine calculates the excluded-volume interaction energy between
14937 ! peptide-group centers and side chains and its gradient in virtual-bond and
14938 ! side-chain vectors.
14940 ! implicit real*8 (a-h,o-z)
14941 ! include 'DIMENSIONS'
14942 ! include 'COMMON.GEO'
14943 ! include 'COMMON.VAR'
14944 ! include 'COMMON.LOCAL'
14945 ! include 'COMMON.CHAIN'
14946 ! include 'COMMON.DERIV'
14947 ! include 'COMMON.INTERACT'
14948 ! include 'COMMON.FFIELD'
14949 ! include 'COMMON.IOUNITS'
14950 ! include 'COMMON.CONTROL'
14951 real(kind=8),dimension(3) :: ggg
14952 !el local variables
14953 integer :: i,iint,j,k,iteli,itypj,subchap
14954 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14955 real(kind=8) :: evdw2,evdw2_14,evdwij
14956 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14957 dist_temp, dist_init
14961 !d print '(a)','Enter ESCP'
14962 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14963 do i=iatscp_s,iatscp_e
14964 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14966 xi=0.5D0*(c(1,i)+c(1,i+1))
14967 yi=0.5D0*(c(2,i)+c(2,i+1))
14968 zi=0.5D0*(c(3,i)+c(3,i+1))
14969 xi=mod(xi,boxxsize)
14970 if (xi.lt.0) xi=xi+boxxsize
14971 yi=mod(yi,boxysize)
14972 if (yi.lt.0) yi=yi+boxysize
14973 zi=mod(zi,boxzsize)
14974 if (zi.lt.0) zi=zi+boxzsize
14976 do iint=1,nscp_gr(i)
14978 do j=iscpstart(i,iint),iscpend(i,iint)
14980 if (itypj.eq.ntyp1) cycle
14981 ! Uncomment following three lines for SC-p interactions
14982 ! xj=c(1,nres+j)-xi
14983 ! yj=c(2,nres+j)-yi
14984 ! zj=c(3,nres+j)-zi
14985 ! Uncomment following three lines for Ca-p interactions
14992 xj=mod(xj,boxxsize)
14993 if (xj.lt.0) xj=xj+boxxsize
14994 yj=mod(yj,boxysize)
14995 if (yj.lt.0) yj=yj+boxysize
14996 zj=mod(zj,boxzsize)
14997 if (zj.lt.0) zj=zj+boxzsize
14998 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15006 xj=xj_safe+xshift*boxxsize
15007 yj=yj_safe+yshift*boxysize
15008 zj=zj_safe+zshift*boxzsize
15009 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15010 if(dist_temp.lt.dist_init) then
15011 dist_init=dist_temp
15020 if (subchap.eq.1) then
15030 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15031 rij=dsqrt(1.0d0/rrij)
15032 sss_ele_cut=sscale_ele(rij)
15033 sss_ele_grad=sscagrad_ele(rij)
15034 ! print *,sss_ele_cut,sss_ele_grad,&
15035 ! (rij),r_cut_ele,rlamb_ele
15036 if (sss_ele_cut.le.0.0) cycle
15037 sss=sscale(rij/rscp(itypj,iteli))
15038 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15039 if (sss.gt.0.0d0) then
15042 e1=fac*fac*aad(itypj,iteli)
15043 e2=fac*bad(itypj,iteli)
15044 if (iabs(j-i) .le. 2) then
15047 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15050 evdw2=evdw2+evdwij*sss*sss_ele_cut
15051 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15052 'evdw2',i,j,sss,evdwij
15054 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15056 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15057 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15058 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15063 ! Uncomment following three lines for SC-p interactions
15065 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15067 ! Uncomment following line for SC-p interactions
15068 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15070 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15071 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15080 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15081 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15082 gradx_scp(j,i)=expon*gradx_scp(j,i)
15085 !******************************************************************************
15089 ! To save time the factor EXPON has been extracted from ALL components
15090 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15093 !******************************************************************************
15095 end subroutine escp_short
15096 !-----------------------------------------------------------------------------
15097 ! energy_p_new-sep_barrier.F
15098 !-----------------------------------------------------------------------------
15099 subroutine sc_grad_scale(scalfac)
15100 ! implicit real*8 (a-h,o-z)
15102 ! include 'DIMENSIONS'
15103 ! include 'COMMON.CHAIN'
15104 ! include 'COMMON.DERIV'
15105 ! include 'COMMON.CALC'
15106 ! include 'COMMON.IOUNITS'
15107 real(kind=8),dimension(3) :: dcosom1,dcosom2
15108 real(kind=8) :: scalfac
15109 !el local variables
15110 ! integer :: i,j,k,l
15112 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15113 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15114 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15115 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15119 ! eom12=evdwij*eps1_om12
15121 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15122 ! & " sigder",sigder
15123 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15124 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15126 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15127 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15130 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15133 ! write (iout,*) "gg",(gg(k),k=1,3)
15135 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15136 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15137 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15139 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15140 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15141 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15143 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15144 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15145 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15146 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15149 ! Calculate the components of the gradient in DC and X
15152 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15153 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15156 end subroutine sc_grad_scale
15157 !-----------------------------------------------------------------------------
15158 ! energy_split-sep.F
15159 !-----------------------------------------------------------------------------
15160 subroutine etotal_long(energia)
15162 ! Compute the long-range slow-varying contributions to the energy
15164 ! implicit real*8 (a-h,o-z)
15165 ! include 'DIMENSIONS'
15166 use MD_data, only: totT,usampl,eq_time
15170 !MS$ATTRIBUTES C :: proc_proc
15175 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15177 ! include 'COMMON.SETUP'
15178 ! include 'COMMON.IOUNITS'
15179 ! include 'COMMON.FFIELD'
15180 ! include 'COMMON.DERIV'
15181 ! include 'COMMON.INTERACT'
15182 ! include 'COMMON.SBRIDGE'
15183 ! include 'COMMON.CHAIN'
15184 ! include 'COMMON.VAR'
15185 ! include 'COMMON.LOCAL'
15186 ! include 'COMMON.MD'
15187 real(kind=8),dimension(0:n_ene) :: energia
15188 !el local variables
15189 integer :: i,n_corr,n_corr1,ierror,ierr
15190 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15191 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15192 ecorr,ecorr5,ecorr6,eturn6,time00
15193 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15194 !elwrite(iout,*)"in etotal long"
15196 if (modecalc.eq.12.or.modecalc.eq.14) then
15198 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15200 call int_from_cart1(.false.)
15203 !elwrite(iout,*)"in etotal long"
15206 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15207 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15209 if (nfgtasks.gt.1) then
15211 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15212 if (fg_rank.eq.0) then
15213 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15214 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15216 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15217 ! FG slaves as WEIGHTS array.
15224 weights_(7)=wel_loc
15227 weights_(10)=wturn6
15229 weights_(12)=wscloc
15231 weights_(14)=wtor_d
15232 weights_(15)=wstrain
15233 weights_(16)=wvdwpp
15235 weights_(18)=scal14
15236 weights_(21)=wsccor
15237 ! FG Master broadcasts the WEIGHTS_ array
15238 call MPI_Bcast(weights_(1),n_ene,&
15239 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15241 ! FG slaves receive the WEIGHTS array
15242 call MPI_Bcast(weights(1),n_ene,&
15243 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15258 wstrain=weights(15)
15264 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15266 time_Bcast=time_Bcast+MPI_Wtime()-time00
15267 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15268 ! call chainbuild_cart
15269 ! call int_from_cart1(.false.)
15271 ! write (iout,*) 'Processor',myrank,
15272 ! & ' calling etotal_short ipot=',ipot
15274 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15276 !d print *,'nnt=',nnt,' nct=',nct
15278 !elwrite(iout,*)"in etotal long"
15279 ! Compute the side-chain and electrostatic interaction energy
15281 goto (101,102,103,104,105,106) ipot
15282 ! Lennard-Jones potential.
15283 101 call elj_long(evdw)
15284 !d print '(a)','Exit ELJ'
15286 ! Lennard-Jones-Kihara potential (shifted).
15287 102 call eljk_long(evdw)
15289 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15290 103 call ebp_long(evdw)
15292 ! Gay-Berne potential (shifted LJ, angular dependence).
15293 104 call egb_long(evdw)
15295 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15296 105 call egbv_long(evdw)
15298 ! Soft-sphere potential
15299 106 call e_softsphere(evdw)
15301 ! Calculate electrostatic (H-bonding) energy of the main chain.
15305 if (ipot.lt.6) then
15307 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15308 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15309 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15310 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15312 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15313 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15314 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15315 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15317 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15326 ! write (iout,*) "Soft-spheer ELEC potential"
15327 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15331 ! Calculate excluded-volume interaction energy between peptide groups
15334 if (ipot.lt.6) then
15335 if(wscp.gt.0d0) then
15336 call escp_long(evdw2,evdw2_14)
15342 call escp_soft_sphere(evdw2,evdw2_14)
15345 ! 12/1/95 Multi-body terms
15349 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15350 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15351 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15352 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15353 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15360 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15361 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15364 ! If performing constraint dynamics, call the constraint energy
15365 ! after the equilibration time
15366 if(usampl.and.totT.gt.eq_time) then
15381 energia(2)=evdw2-evdw2_14
15382 energia(18)=evdw2_14
15391 energia(3)=ees+evdw1
15398 energia(8)=eello_turn3
15399 energia(9)=eello_turn4
15401 energia(20)=Uconst+Uconst_back
15402 call sum_energy(energia,.true.)
15403 ! write (iout,*) "Exit ETOTAL_LONG"
15406 end subroutine etotal_long
15407 !-----------------------------------------------------------------------------
15408 subroutine etotal_short(energia)
15410 ! Compute the short-range fast-varying contributions to the energy
15412 ! implicit real*8 (a-h,o-z)
15413 ! include 'DIMENSIONS'
15417 !MS$ATTRIBUTES C :: proc_proc
15422 integer :: ierror,ierr
15423 real(kind=8),dimension(n_ene) :: weights_
15424 real(kind=8) :: time00
15426 ! include 'COMMON.SETUP'
15427 ! include 'COMMON.IOUNITS'
15428 ! include 'COMMON.FFIELD'
15429 ! include 'COMMON.DERIV'
15430 ! include 'COMMON.INTERACT'
15431 ! include 'COMMON.SBRIDGE'
15432 ! include 'COMMON.CHAIN'
15433 ! include 'COMMON.VAR'
15434 ! include 'COMMON.LOCAL'
15435 real(kind=8),dimension(0:n_ene) :: energia
15436 !el local variables
15438 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15439 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15442 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15444 if (modecalc.eq.12.or.modecalc.eq.14) then
15446 if (fg_rank.eq.0) call int_from_cart1(.false.)
15448 call int_from_cart1(.false.)
15452 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15453 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15455 if (nfgtasks.gt.1) then
15457 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15458 if (fg_rank.eq.0) then
15459 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15460 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15462 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15463 ! FG slaves as WEIGHTS array.
15470 weights_(7)=wel_loc
15473 weights_(10)=wturn6
15475 weights_(12)=wscloc
15477 weights_(14)=wtor_d
15478 weights_(15)=wstrain
15479 weights_(16)=wvdwpp
15481 weights_(18)=scal14
15482 weights_(21)=wsccor
15483 ! FG Master broadcasts the WEIGHTS_ array
15484 call MPI_Bcast(weights_(1),n_ene,&
15485 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15487 ! FG slaves receive the WEIGHTS array
15488 call MPI_Bcast(weights(1),n_ene,&
15489 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15504 wstrain=weights(15)
15510 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15511 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15513 ! write (iout,*) "Processor",myrank," BROADCAST c"
15514 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15516 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15517 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15519 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15520 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15522 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15523 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15525 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15526 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15528 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15529 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15531 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15532 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15534 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15535 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15537 time_Bcast=time_Bcast+MPI_Wtime()-time00
15538 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15540 ! write (iout,*) 'Processor',myrank,
15541 ! & ' calling etotal_short ipot=',ipot
15543 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15545 ! call int_from_cart1(.false.)
15547 ! Compute the side-chain and electrostatic interaction energy
15549 goto (101,102,103,104,105,106) ipot
15550 ! Lennard-Jones potential.
15551 101 call elj_short(evdw)
15552 !d print '(a)','Exit ELJ'
15554 ! Lennard-Jones-Kihara potential (shifted).
15555 102 call eljk_short(evdw)
15557 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15558 103 call ebp_short(evdw)
15560 ! Gay-Berne potential (shifted LJ, angular dependence).
15561 104 call egb_short(evdw)
15563 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15564 105 call egbv_short(evdw)
15566 ! Soft-sphere potential - already dealt with in the long-range part
15568 ! 106 call e_softsphere_short(evdw)
15570 ! Calculate electrostatic (H-bonding) energy of the main chain.
15574 ! Calculate the short-range part of Evdwpp
15576 call evdwpp_short(evdw1)
15578 ! Calculate the short-range part of ESCp
15580 if (ipot.lt.6) then
15581 call escp_short(evdw2,evdw2_14)
15584 ! Calculate the bond-stretching energy
15588 ! Calculate the disulfide-bridge and other energy and the contributions
15589 ! from other distance constraints.
15592 ! Calculate the virtual-bond-angle energy.
15594 call ebend(ebe,ethetacnstr)
15596 ! Calculate the SC local energy.
15601 ! Calculate the virtual-bond torsional energy.
15603 call etor(etors,edihcnstr)
15605 ! 6/23/01 Calculate double-torsional energy
15607 call etor_d(etors_d)
15609 ! 21/5/07 Calculate local sicdechain correlation energy
15611 if (wsccor.gt.0.0d0) then
15612 call eback_sc_corr(esccor)
15617 ! Put energy components into an array
15624 energia(2)=evdw2-evdw2_14
15625 energia(18)=evdw2_14
15638 energia(14)=etors_d
15641 energia(19)=edihcnstr
15643 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15645 call sum_energy(energia,.true.)
15646 ! write (iout,*) "Exit ETOTAL_SHORT"
15649 end subroutine etotal_short
15650 !-----------------------------------------------------------------------------
15652 !-----------------------------------------------------------------------------
15653 real(kind=8) function gnmr1(y,ymin,ymax)
15655 real(kind=8) :: y,ymin,ymax
15656 real(kind=8) :: wykl=4.0d0
15657 if (y.lt.ymin) then
15658 gnmr1=(ymin-y)**wykl/wykl
15659 else if (y.gt.ymax) then
15660 gnmr1=(y-ymax)**wykl/wykl
15666 !-----------------------------------------------------------------------------
15667 real(kind=8) function gnmr1prim(y,ymin,ymax)
15669 real(kind=8) :: y,ymin,ymax
15670 real(kind=8) :: wykl=4.0d0
15671 if (y.lt.ymin) then
15672 gnmr1prim=-(ymin-y)**(wykl-1)
15673 else if (y.gt.ymax) then
15674 gnmr1prim=(y-ymax)**(wykl-1)
15679 end function gnmr1prim
15680 !----------------------------------------------------------------------------
15681 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15682 real(kind=8) y,ymin,ymax,sigma
15683 real(kind=8) wykl /4.0d0/
15684 if (y.lt.ymin) then
15685 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
15686 else if (y.gt.ymax) then
15687 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
15692 end function rlornmr1
15693 !------------------------------------------------------------------------------
15694 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
15695 real(kind=8) y,ymin,ymax,sigma
15696 real(kind=8) wykl /4.0d0/
15697 if (y.lt.ymin) then
15698 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
15699 ((ymin-y)**wykl+sigma**wykl)**2
15700 else if (y.gt.ymax) then
15701 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
15702 ((y-ymax)**wykl+sigma**wykl)**2
15707 end function rlornmr1prim
15709 real(kind=8) function harmonic(y,ymax)
15711 real(kind=8) :: y,ymax
15712 real(kind=8) :: wykl=2.0d0
15713 harmonic=(y-ymax)**wykl
15715 end function harmonic
15716 !-----------------------------------------------------------------------------
15717 real(kind=8) function harmonicprim(y,ymax)
15718 real(kind=8) :: y,ymin,ymax
15719 real(kind=8) :: wykl=2.0d0
15720 harmonicprim=(y-ymax)*wykl
15722 end function harmonicprim
15723 !-----------------------------------------------------------------------------
15725 !-----------------------------------------------------------------------------
15726 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
15728 use io_base, only:intout,briefout
15729 ! implicit real*8 (a-h,o-z)
15730 ! include 'DIMENSIONS'
15731 ! include 'COMMON.CHAIN'
15732 ! include 'COMMON.DERIV'
15733 ! include 'COMMON.VAR'
15734 ! include 'COMMON.INTERACT'
15735 ! include 'COMMON.FFIELD'
15736 ! include 'COMMON.MD'
15737 ! include 'COMMON.IOUNITS'
15738 real(kind=8),external :: ufparm
15739 integer :: uiparm(1)
15740 real(kind=8) :: urparm(1)
15741 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
15742 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
15743 integer :: n,nf,ind,ind1,i,k,j
15745 ! This subroutine calculates total internal coordinate gradient.
15746 ! Depending on the number of function evaluations, either whole energy
15747 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
15748 ! internal coordinates are reevaluated or only the cartesian-in-internal
15749 ! coordinate derivatives are evaluated. The subroutine was designed to work
15755 !d print *,'grad',nf,icg
15756 if (nf-nfl+1) 20,30,40
15757 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
15758 ! write (iout,*) 'grad 20'
15759 if (nf.eq.0) return
15761 30 call var_to_geom(n,x)
15763 ! write (iout,*) 'grad 30'
15765 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
15768 ! write (iout,*) 'grad 40'
15769 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
15771 ! Convert the Cartesian gradient into internal-coordinate gradient.
15781 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
15783 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
15786 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
15792 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
15794 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
15795 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
15798 if (i.gt.1) g(i-1)=gphii
15799 if (n.gt.nphi) g(nphi+i)=gthetai
15801 if (n.le.nphi+ntheta) goto 10
15803 if (itype(i,1).ne.10) then
15807 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
15810 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
15812 g(ialph(i,1))=galphai
15813 g(ialph(i,1)+nside)=gomegai
15817 ! Add the components corresponding to local energy terms.
15821 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
15822 g(i)=g(i)+gloc(i,icg)
15824 ! Uncomment following three lines for diagnostics.
15826 !elwrite(iout,*) "in gradient after calling intout"
15827 !d call briefout(0,0.0d0)
15828 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
15830 end subroutine gradient
15831 !-----------------------------------------------------------------------------
15832 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
15835 ! implicit real*8 (a-h,o-z)
15836 ! include 'DIMENSIONS'
15837 ! include 'COMMON.DERIV'
15838 ! include 'COMMON.IOUNITS'
15839 ! include 'COMMON.GEO'
15842 !el common /chuju/ jjj
15843 real(kind=8) :: energia(0:n_ene)
15844 integer :: uiparm(1)
15845 real(kind=8) :: urparm(1)
15847 real(kind=8),external :: ufparm
15848 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
15849 ! if (jjj.gt.0) then
15850 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15854 !d print *,'func',nf,nfl,icg
15855 call var_to_geom(n,x)
15858 !d write (iout,*) 'ETOTAL called from FUNC'
15859 call etotal(energia)
15862 ! if (jjj.gt.0) then
15863 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15864 ! write (iout,*) 'f=',etot
15868 end subroutine func
15869 !-----------------------------------------------------------------------------
15870 subroutine cartgrad
15871 ! implicit real*8 (a-h,o-z)
15872 ! include 'DIMENSIONS'
15874 use MD_data, only: totT,usampl,eq_time
15878 ! include 'COMMON.CHAIN'
15879 ! include 'COMMON.DERIV'
15880 ! include 'COMMON.VAR'
15881 ! include 'COMMON.INTERACT'
15882 ! include 'COMMON.FFIELD'
15883 ! include 'COMMON.MD'
15884 ! include 'COMMON.IOUNITS'
15885 ! include 'COMMON.TIME1'
15889 ! This subrouting calculates total Cartesian coordinate gradient.
15890 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
15900 !el write (iout,*) "After sum_gradient"
15902 !el write (iout,*) "After sum_gradient"
15904 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
15905 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
15908 ! If performing constraint dynamics, add the gradients of the constraint energy
15909 if(usampl.and.totT.gt.eq_time) then
15912 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
15913 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
15917 gloc(i,icg)=gloc(i,icg)+dugamma(i)
15920 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
15923 !elwrite (iout,*) "After sum_gradient"
15928 !elwrite (iout,*) "After sum_gradient"
15930 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
15932 ! call checkintcartgrad
15933 ! write(iout,*) 'calling int_to_cart'
15935 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
15939 gcart(j,i)=gradc(j,i,icg)
15940 gxcart(j,i)=gradx(j,i,icg)
15943 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
15944 (gxcart(j,i),j=1,3),gloc(i,icg)
15952 time_inttocart=time_inttocart+MPI_Wtime()-time01
15955 write (iout,*) "gcart and gxcart after int_to_cart"
15957 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
15958 (gxcart(j,i),j=1,3)
15963 write (iout,*) "CARGRAD"
15967 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15968 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
15970 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
15971 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
15973 ! Correction: dummy residues
15976 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
15977 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
15980 if (nct.lt.nres) then
15982 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
15983 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
15988 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
15992 end subroutine cartgrad
15993 !-----------------------------------------------------------------------------
15994 subroutine zerograd
15995 ! implicit real*8 (a-h,o-z)
15996 ! include 'DIMENSIONS'
15997 ! include 'COMMON.DERIV'
15998 ! include 'COMMON.CHAIN'
15999 ! include 'COMMON.VAR'
16000 ! include 'COMMON.MD'
16001 ! include 'COMMON.SCCOR'
16003 !el local variables
16004 integer :: i,j,intertyp,k
16005 ! Initialize Cartesian-coordinate gradient
16007 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16008 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16010 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16011 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16012 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16013 ! allocate(gradcorr_long(3,nres))
16014 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16015 ! allocate(gcorr6_turn_long(3,nres))
16016 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16018 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16020 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16021 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16023 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16024 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16026 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16027 ! allocate(gscloc(3,nres)) !(3,maxres)
16028 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16032 ! common /deriv_scloc/
16033 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16034 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16035 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16037 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16041 ! gradc(j,i,icg)=0.0d0
16042 ! gradx(j,i,icg)=0.0d0
16044 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16045 !elwrite(iout,*) "icg",icg
16049 gradx_scp(j,i)=0.0D0
16051 gvdwc_scp(j,i)=0.0D0
16052 gvdwc_scpp(j,i)=0.0d0
16054 gelc_long(j,i)=0.0D0
16059 gel_loc_long(j,i)=0.0d0
16062 gcorr3_turn(j,i)=0.0d0
16063 gcorr4_turn(j,i)=0.0d0
16064 gradcorr(j,i)=0.0d0
16065 gradcorr_long(j,i)=0.0d0
16066 gradcorr5_long(j,i)=0.0d0
16067 gradcorr6_long(j,i)=0.0d0
16068 gcorr6_turn_long(j,i)=0.0d0
16069 gradcorr5(j,i)=0.0d0
16070 gradcorr6(j,i)=0.0d0
16071 gcorr6_turn(j,i)=0.0d0
16074 gradc(j,i,icg)=0.0d0
16075 gradx(j,i,icg)=0.0d0
16078 gliptran(j,i)=0.0d0
16079 gliptranx(j,i)=0.0d0
16080 gliptranc(j,i)=0.0d0
16081 gshieldx(j,i)=0.0d0
16082 gshieldc(j,i)=0.0d0
16083 gshieldc_loc(j,i)=0.0d0
16084 gshieldx_ec(j,i)=0.0d0
16085 gshieldc_ec(j,i)=0.0d0
16086 gshieldc_loc_ec(j,i)=0.0d0
16087 gshieldx_t3(j,i)=0.0d0
16088 gshieldc_t3(j,i)=0.0d0
16089 gshieldc_loc_t3(j,i)=0.0d0
16090 gshieldx_t4(j,i)=0.0d0
16091 gshieldc_t4(j,i)=0.0d0
16092 gshieldc_loc_t4(j,i)=0.0d0
16093 gshieldx_ll(j,i)=0.0d0
16094 gshieldc_ll(j,i)=0.0d0
16095 gshieldc_loc_ll(j,i)=0.0d0
16097 gg_tube_sc(j,i)=0.0d0
16100 gloc_sc(intertyp,i,icg)=0.0d0
16109 grad_shield_side(k,j,i)=0.0d0
16110 grad_shield_loc(k,j,i)=0.0d0
16117 ! Initialize the gradient of local energy terms.
16119 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16120 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16121 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16122 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16123 ! allocate(gel_loc_turn3(nres))
16124 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16125 ! allocate(gsccor_loc(nres)) !(maxres)
16131 gel_loc_loc(i)=0.0d0
16133 g_corr5_loc(i)=0.0d0
16134 g_corr6_loc(i)=0.0d0
16135 gel_loc_turn3(i)=0.0d0
16136 gel_loc_turn4(i)=0.0d0
16137 gel_loc_turn6(i)=0.0d0
16138 gsccor_loc(i)=0.0d0
16140 ! initialize gcart and gxcart
16141 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16149 end subroutine zerograd
16150 !-----------------------------------------------------------------------------
16151 real(kind=8) function fdum()
16155 !-----------------------------------------------------------------------------
16157 !-----------------------------------------------------------------------------
16158 subroutine intcartderiv
16159 ! implicit real*8 (a-h,o-z)
16160 ! include 'DIMENSIONS'
16164 ! include 'COMMON.SETUP'
16165 ! include 'COMMON.CHAIN'
16166 ! include 'COMMON.VAR'
16167 ! include 'COMMON.GEO'
16168 ! include 'COMMON.INTERACT'
16169 ! include 'COMMON.DERIV'
16170 ! include 'COMMON.IOUNITS'
16171 ! include 'COMMON.LOCAL'
16172 ! include 'COMMON.SCCOR'
16173 real(kind=8) :: pi4,pi34
16174 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16175 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16176 dcosomega,dsinomega !(3,3,maxres)
16177 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16180 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16181 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16182 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16183 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16187 !el from module energy-------------
16188 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16189 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16190 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16192 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16193 !el allocate(dsintau(3,3,3,0:nres2))
16194 !el allocate(dtauangle(3,3,3,0:nres2))
16195 !el allocate(domicron(3,2,2,0:nres2))
16196 !el allocate(dcosomicron(3,2,2,0:nres2))
16200 #if defined(MPI) && defined(PARINTDER)
16201 if (nfgtasks.gt.1 .and. me.eq.king) &
16202 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16207 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16208 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16210 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16213 dtheta(j,1,i)=0.0d0
16214 dtheta(j,2,i)=0.0d0
16220 ! Derivatives of theta's
16221 #if defined(MPI) && defined(PARINTDER)
16222 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16223 do i=max0(ithet_start-1,3),ithet_end
16227 cost=dcos(theta(i))
16228 sint=sqrt(1-cost*cost)
16230 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16232 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16233 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16235 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16238 #if defined(MPI) && defined(PARINTDER)
16239 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16240 do i=max0(ithet_start-1,3),ithet_end
16244 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16245 cost1=dcos(omicron(1,i))
16246 sint1=sqrt(1-cost1*cost1)
16247 cost2=dcos(omicron(2,i))
16248 sint2=sqrt(1-cost2*cost2)
16250 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16251 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16252 cost1*dc_norm(j,i-2))/ &
16254 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16255 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16256 +cost1*(dc_norm(j,i-1+nres)))/ &
16258 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16259 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16260 !C Looks messy but better than if in loop
16261 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16262 +cost2*dc_norm(j,i-1))/ &
16264 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16265 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16266 +cost2*(-dc_norm(j,i-1+nres)))/ &
16268 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16269 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16273 !elwrite(iout,*) "after vbld write"
16274 ! Derivatives of phi:
16275 ! If phi is 0 or 180 degrees, then the formulas
16276 ! have to be derived by power series expansion of the
16277 ! conventional formulas around 0 and 180.
16279 do i=iphi1_start,iphi1_end
16283 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16284 ! the conventional case
16285 sint=dsin(theta(i))
16286 sint1=dsin(theta(i-1))
16288 cost=dcos(theta(i))
16289 cost1=dcos(theta(i-1))
16291 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16292 fac0=1.0d0/(sint1*sint)
16295 fac3=cosg*cost1/(sint1*sint1)
16296 fac4=cosg*cost/(sint*sint)
16297 ! Obtaining the gamma derivatives from sine derivative
16298 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16299 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16300 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16301 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16302 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16303 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16307 cosg_inv=1.0d0/cosg
16308 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16309 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16310 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16311 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16313 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16314 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16315 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16316 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16317 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16318 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16319 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16321 ! Bug fixed 3/24/05 (AL)
16323 ! Obtaining the gamma derivatives from cosine derivative
16326 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16327 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16328 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16329 dc_norm(j,i-3))/vbld(i-2)
16330 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16331 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16332 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16334 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16335 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16336 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16337 dc_norm(j,i-1))/vbld(i)
16338 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16343 !alculate derivative of Tauangle
16345 do i=itau_start,itau_end
16348 !elwrite(iout,*) " vecpr",i,nres
16350 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16351 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16352 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16353 !c dtauangle(j,intertyp,dervityp,residue number)
16354 !c INTERTYP=1 SC...Ca...Ca..Ca
16355 ! the conventional case
16356 sint=dsin(theta(i))
16357 sint1=dsin(omicron(2,i-1))
16358 sing=dsin(tauangle(1,i))
16359 cost=dcos(theta(i))
16360 cost1=dcos(omicron(2,i-1))
16361 cosg=dcos(tauangle(1,i))
16362 !elwrite(iout,*) " vecpr5",i,nres
16364 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16365 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16366 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16367 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16369 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16370 fac0=1.0d0/(sint1*sint)
16373 fac3=cosg*cost1/(sint1*sint1)
16374 fac4=cosg*cost/(sint*sint)
16375 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16376 ! Obtaining the gamma derivatives from sine derivative
16377 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16378 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16379 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16380 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16381 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16382 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16386 cosg_inv=1.0d0/cosg
16387 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16388 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16389 *vbld_inv(i-2+nres)
16390 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16391 dsintau(j,1,2,i)= &
16392 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16393 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16394 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16395 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16396 ! Bug fixed 3/24/05 (AL)
16397 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16398 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16399 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16400 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16402 ! Obtaining the gamma derivatives from cosine derivative
16405 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16406 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16407 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16408 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16409 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16410 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16412 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16413 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16414 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16415 dc_norm(j,i-1))/vbld(i)
16416 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16417 ! write (iout,*) "else",i
16421 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16424 !C Second case Ca...Ca...Ca...SC
16426 do i=itau_start,itau_end
16430 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16431 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16432 ! the conventional case
16433 sint=dsin(omicron(1,i))
16434 sint1=dsin(theta(i-1))
16435 sing=dsin(tauangle(2,i))
16436 cost=dcos(omicron(1,i))
16437 cost1=dcos(theta(i-1))
16438 cosg=dcos(tauangle(2,i))
16440 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16442 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16443 fac0=1.0d0/(sint1*sint)
16446 fac3=cosg*cost1/(sint1*sint1)
16447 fac4=cosg*cost/(sint*sint)
16448 ! Obtaining the gamma derivatives from sine derivative
16449 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16450 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16451 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16452 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16453 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16454 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16458 cosg_inv=1.0d0/cosg
16459 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16460 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16461 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16462 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16463 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16464 dsintau(j,2,2,i)= &
16465 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16466 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16467 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16468 ! & sing*ctgt*domicron(j,1,2,i),
16469 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16470 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16471 ! Bug fixed 3/24/05 (AL)
16472 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16473 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16474 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16475 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16477 ! Obtaining the gamma derivatives from cosine derivative
16480 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16481 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16482 dc_norm(j,i-3))/vbld(i-2)
16483 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16484 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16485 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16486 dcosomicron(j,1,1,i)
16487 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16488 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16489 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16490 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16491 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16492 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16497 !CC third case SC...Ca...Ca...SC
16500 do i=itau_start,itau_end
16504 ! the conventional case
16505 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16506 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16507 sint=dsin(omicron(1,i))
16508 sint1=dsin(omicron(2,i-1))
16509 sing=dsin(tauangle(3,i))
16510 cost=dcos(omicron(1,i))
16511 cost1=dcos(omicron(2,i-1))
16512 cosg=dcos(tauangle(3,i))
16514 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16515 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16517 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16518 fac0=1.0d0/(sint1*sint)
16521 fac3=cosg*cost1/(sint1*sint1)
16522 fac4=cosg*cost/(sint*sint)
16523 ! Obtaining the gamma derivatives from sine derivative
16524 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16525 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16526 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16527 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16528 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16529 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16533 cosg_inv=1.0d0/cosg
16534 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16535 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16536 *vbld_inv(i-2+nres)
16537 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16538 dsintau(j,3,2,i)= &
16539 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16540 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16541 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16542 ! Bug fixed 3/24/05 (AL)
16543 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16544 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16545 *vbld_inv(i-1+nres)
16546 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16547 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16549 ! Obtaining the gamma derivatives from cosine derivative
16552 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16553 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16554 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16555 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16556 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16557 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16558 dcosomicron(j,1,1,i)
16559 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16560 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16561 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16562 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16563 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16564 ! write(iout,*) "else",i
16570 ! Derivatives of side-chain angles alpha and omega
16571 #if defined(MPI) && defined(PARINTDER)
16572 do i=ibond_start,ibond_end
16576 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16577 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16580 fac8=fac5/vbld(i+1)
16581 fac9=fac5/vbld(i+nres)
16582 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16583 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16584 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16585 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16586 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16587 sina=sqrt(1-cosa*cosa)
16589 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16591 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16592 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16593 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16594 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16595 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16596 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16597 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16598 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16600 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16602 ! obtaining the derivatives of omega from sines
16603 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16604 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16605 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16606 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16608 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16609 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16610 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16611 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16612 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16613 coso_inv=1.0d0/dcos(omeg(i))
16615 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16616 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16617 (sino*dc_norm(j,i-1))/vbld(i)
16618 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16619 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16620 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16621 -sino*dc_norm(j,i)/vbld(i+1)
16622 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16623 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16624 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16626 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16629 ! obtaining the derivatives of omega from cosines
16630 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16631 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16636 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16637 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16638 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16639 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16640 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16641 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16642 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16643 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16644 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16645 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16646 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16647 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16648 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16649 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16650 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16656 dalpha(k,j,i)=0.0d0
16657 domega(k,j,i)=0.0d0
16663 #if defined(MPI) && defined(PARINTDER)
16664 if (nfgtasks.gt.1) then
16666 !d write (iout,*) "Gather dtheta"
16667 !d call flush(iout)
16668 write (iout,*) "dtheta before gather"
16670 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
16673 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
16674 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
16675 king,FG_COMM,IERROR)
16677 !d write (iout,*) "Gather dphi"
16678 !d call flush(iout)
16679 write (iout,*) "dphi before gather"
16681 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
16684 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
16685 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
16686 king,FG_COMM,IERROR)
16687 !d write (iout,*) "Gather dalpha"
16688 !d call flush(iout)
16690 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
16691 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16692 king,FG_COMM,IERROR)
16693 !d write (iout,*) "Gather domega"
16694 !d call flush(iout)
16695 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
16696 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16697 king,FG_COMM,IERROR)
16702 write (iout,*) "dtheta after gather"
16704 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
16706 write (iout,*) "dphi after gather"
16708 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
16710 write (iout,*) "dalpha after gather"
16712 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
16714 write (iout,*) "domega after gather"
16716 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
16720 end subroutine intcartderiv
16721 !-----------------------------------------------------------------------------
16722 subroutine checkintcartgrad
16723 ! implicit real*8 (a-h,o-z)
16724 ! include 'DIMENSIONS'
16728 ! include 'COMMON.CHAIN'
16729 ! include 'COMMON.VAR'
16730 ! include 'COMMON.GEO'
16731 ! include 'COMMON.INTERACT'
16732 ! include 'COMMON.DERIV'
16733 ! include 'COMMON.IOUNITS'
16734 ! include 'COMMON.SETUP'
16735 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
16736 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
16737 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
16738 real(kind=8),dimension(3) :: dc_norm_s
16739 real(kind=8) :: aincr=1.0d-5
16741 real(kind=8) :: dcji
16744 theta_s(i)=theta(i)
16748 ! Check theta gradient
16750 "Analytical (upper) and numerical (lower) gradient of theta"
16755 dc(j,i-2)=dcji+aincr
16756 call chainbuild_cart
16757 call int_from_cart1(.false.)
16758 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
16761 dc(j,i-1)=dc(j,i-1)+aincr
16762 call chainbuild_cart
16763 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
16766 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
16767 !el (dtheta(j,2,i),j=1,3)
16768 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
16769 !el (dthetanum(j,2,i),j=1,3)
16770 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
16771 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
16772 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
16775 ! Check gamma gradient
16777 "Analytical (upper) and numerical (lower) gradient of gamma"
16781 dc(j,i-3)=dcji+aincr
16782 call chainbuild_cart
16783 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
16786 dc(j,i-2)=dcji+aincr
16787 call chainbuild_cart
16788 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
16791 dc(j,i-1)=dc(j,i-1)+aincr
16792 call chainbuild_cart
16793 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
16796 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
16797 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
16798 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
16799 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
16800 !el write (iout,'(5x,3(3f10.5,5x))') &
16801 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
16802 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
16803 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
16806 ! Check alpha gradient
16808 "Analytical (upper) and numerical (lower) gradient of alpha"
16810 if(itype(i,1).ne.10) then
16813 dc(j,i-1)=dcji+aincr
16814 call chainbuild_cart
16815 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
16820 call chainbuild_cart
16821 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
16825 dc(j,i+nres)=dc(j,i+nres)+aincr
16826 call chainbuild_cart
16827 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
16832 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
16833 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
16834 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
16835 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
16836 !el write (iout,'(5x,3(3f10.5,5x))') &
16837 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
16838 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
16839 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
16842 ! Check omega gradient
16844 "Analytical (upper) and numerical (lower) gradient of omega"
16846 if(itype(i,1).ne.10) then
16849 dc(j,i-1)=dcji+aincr
16850 call chainbuild_cart
16851 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
16856 call chainbuild_cart
16857 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
16861 dc(j,i+nres)=dc(j,i+nres)+aincr
16862 call chainbuild_cart
16863 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
16868 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
16869 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
16870 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
16871 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
16872 !el write (iout,'(5x,3(3f10.5,5x))') &
16873 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
16874 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
16875 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
16879 end subroutine checkintcartgrad
16880 !-----------------------------------------------------------------------------
16882 !-----------------------------------------------------------------------------
16883 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
16884 ! implicit real*8 (a-h,o-z)
16885 ! include 'DIMENSIONS'
16886 ! include 'COMMON.IOUNITS'
16887 ! include 'COMMON.CHAIN'
16888 ! include 'COMMON.INTERACT'
16889 ! include 'COMMON.VAR'
16890 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
16891 integer :: kkk,nsep=3
16892 real(kind=8) :: qm !dist,
16893 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
16894 logical :: lprn=.false.
16896 ! real(kind=8) :: sigm,x
16898 !el sigm(x)=0.25d0*x ! local function
16904 do il=seg1+nsep,seg2
16907 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
16908 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
16909 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16911 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16912 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
16915 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16916 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16917 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16918 dijCM=dist(il+nres,jl+nres)
16919 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16921 qq = qq+qqij+qqijCM
16927 if((seg3-il).lt.3) then
16934 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16935 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16936 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16938 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
16939 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
16942 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
16943 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
16944 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
16945 dijCM=dist(il+nres,jl+nres)
16946 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
16948 qq = qq+qqij+qqijCM
16953 if (qqmax.le.qq) qqmax=qq
16955 qwolynes=1.0d0-qqmax
16957 end function qwolynes
16958 !-----------------------------------------------------------------------------
16959 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
16960 ! implicit real*8 (a-h,o-z)
16961 ! include 'DIMENSIONS'
16962 ! include 'COMMON.IOUNITS'
16963 ! include 'COMMON.CHAIN'
16964 ! include 'COMMON.INTERACT'
16965 ! include 'COMMON.VAR'
16966 ! include 'COMMON.MD'
16967 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
16968 integer :: nsep=3, kkk
16969 !el real(kind=8) :: dist
16970 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
16971 logical :: lprn=.false.
16973 real(kind=8) :: sim,dd0,fac,ddqij
16974 !el sigm(x)=0.25d0*x ! local function
16984 do il=seg1+nsep,seg2
16987 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
16988 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
16989 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
16991 sim = 1.0d0/sigm(d0ij)
16994 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
16996 ddqij = (c(k,il)-c(k,jl))*fac
16997 dqwol(k,il)=dqwol(k,il)+ddqij
16998 dqwol(k,jl)=dqwol(k,jl)-ddqij
17001 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17004 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17005 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17006 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17007 dijCM=dist(il+nres,jl+nres)
17008 sim = 1.0d0/sigm(d0ijCM)
17011 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17013 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17014 dxqwol(k,il)=dxqwol(k,il)+ddqij
17015 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17022 if((seg3-il).lt.3) then
17029 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17030 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17031 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17033 sim = 1.0d0/sigm(d0ij)
17036 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17038 ddqij = (c(k,il)-c(k,jl))*fac
17039 dqwol(k,il)=dqwol(k,il)+ddqij
17040 dqwol(k,jl)=dqwol(k,jl)-ddqij
17042 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17045 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17046 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17047 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17048 dijCM=dist(il+nres,jl+nres)
17049 sim = 1.0d0/sigm(d0ijCM)
17052 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17054 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17055 dxqwol(k,il)=dxqwol(k,il)+ddqij
17056 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17065 dqwol(j,i)=dqwol(j,i)/nl
17066 dxqwol(j,i)=dxqwol(j,i)/nl
17070 end subroutine qwolynes_prim
17071 !-----------------------------------------------------------------------------
17072 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17073 ! implicit real*8 (a-h,o-z)
17074 ! include 'DIMENSIONS'
17075 ! include 'COMMON.IOUNITS'
17076 ! include 'COMMON.CHAIN'
17077 ! include 'COMMON.INTERACT'
17078 ! include 'COMMON.VAR'
17079 integer :: seg1,seg2,seg3,seg4
17081 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17082 real(kind=8),dimension(3,0:2*nres) :: cdummy
17083 real(kind=8) :: q1,q2
17084 real(kind=8) :: delta=1.0d-10
17089 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17091 c(j,i)=c(j,i)+delta
17092 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17093 qwolan(j,i)=(q2-q1)/delta
17099 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17100 cdummy(j,i+nres)=c(j,i+nres)
17101 c(j,i+nres)=c(j,i+nres)+delta
17102 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17103 qwolxan(j,i)=(q2-q1)/delta
17104 c(j,i+nres)=cdummy(j,i+nres)
17107 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17109 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17111 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17113 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17116 end subroutine qwol_num
17117 !-----------------------------------------------------------------------------
17118 subroutine EconstrQ
17119 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17120 ! implicit real*8 (a-h,o-z)
17121 ! include 'DIMENSIONS'
17122 ! include 'COMMON.CONTROL'
17123 ! include 'COMMON.VAR'
17124 ! include 'COMMON.MD'
17127 ! include 'COMMON.LANGEVIN'
17129 ! include 'COMMON.LANGEVIN.lang0'
17131 ! include 'COMMON.CHAIN'
17132 ! include 'COMMON.DERIV'
17133 ! include 'COMMON.GEO'
17134 ! include 'COMMON.LOCAL'
17135 ! include 'COMMON.INTERACT'
17136 ! include 'COMMON.IOUNITS'
17137 ! include 'COMMON.NAMES'
17138 ! include 'COMMON.TIME1'
17139 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17140 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17142 integer :: kstart,kend,lstart,lend,idummy
17143 real(kind=8) :: delta=1.0d-7
17144 integer :: i,j,k,ii
17148 dudconst(j,i)=0.0d0
17149 duxconst(j,i)=0.0d0
17150 dudxconst(j,i)=0.0d0
17155 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17157 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17158 ! Calculating the derivatives of Constraint energy with respect to Q
17159 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17161 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17162 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17163 ! hmnum=(hm2-hm1)/delta
17164 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17165 ! & qinfrag(i,iset))
17166 ! write(iout,*) "harmonicnum frag", hmnum
17167 ! Calculating the derivatives of Q with respect to cartesian coordinates
17168 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17170 ! write(iout,*) "dqwol "
17172 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17174 ! write(iout,*) "dxqwol "
17176 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17178 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17179 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17180 ! & ,idummy,idummy)
17181 ! The gradients of Uconst in Cs
17184 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17185 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17190 kstart=ifrag(1,ipair(1,i,iset),iset)
17191 kend=ifrag(2,ipair(1,i,iset),iset)
17192 lstart=ifrag(1,ipair(2,i,iset),iset)
17193 lend=ifrag(2,ipair(2,i,iset),iset)
17194 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17195 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17196 ! Calculating dU/dQ
17197 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17198 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17199 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17200 ! hmnum=(hm2-hm1)/delta
17201 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17202 ! & qinpair(i,iset))
17203 ! write(iout,*) "harmonicnum pair ", hmnum
17204 ! Calculating dQ/dXi
17205 call qwolynes_prim(kstart,kend,.false.,&
17207 ! write(iout,*) "dqwol "
17209 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17211 ! write(iout,*) "dxqwol "
17213 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17215 ! Calculating numerical gradients
17216 ! call qwol_num(kstart,kend,.false.
17218 ! The gradients of Uconst in Cs
17221 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17222 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17226 ! write(iout,*) "Uconst inside subroutine ", Uconst
17227 ! Transforming the gradients from Cs to dCs for the backbone
17231 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17235 ! Transforming the gradients from Cs to dCs for the side chains
17238 dudxconst(j,i)=duxconst(j,i)
17241 ! write(iout,*) "dU/ddc backbone "
17243 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17245 ! write(iout,*) "dU/ddX side chain "
17247 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17249 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17250 ! call dEconstrQ_num
17252 end subroutine EconstrQ
17253 !-----------------------------------------------------------------------------
17254 subroutine dEconstrQ_num
17255 ! Calculating numerical dUconst/ddc and dUconst/ddx
17256 ! implicit real*8 (a-h,o-z)
17257 ! include 'DIMENSIONS'
17258 ! include 'COMMON.CONTROL'
17259 ! include 'COMMON.VAR'
17260 ! include 'COMMON.MD'
17263 ! include 'COMMON.LANGEVIN'
17265 ! include 'COMMON.LANGEVIN.lang0'
17267 ! include 'COMMON.CHAIN'
17268 ! include 'COMMON.DERIV'
17269 ! include 'COMMON.GEO'
17270 ! include 'COMMON.LOCAL'
17271 ! include 'COMMON.INTERACT'
17272 ! include 'COMMON.IOUNITS'
17273 ! include 'COMMON.NAMES'
17274 ! include 'COMMON.TIME1'
17275 real(kind=8) :: uzap1,uzap2
17276 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17277 integer :: kstart,kend,lstart,lend,idummy
17278 real(kind=8) :: delta=1.0d-7
17279 !el local variables
17285 dUcartan(j,i)=0.0d0
17286 cdummy(j,i)=dc(j,i)
17287 dc(j,i)=dc(j,i)+delta
17288 call chainbuild_cart
17291 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17293 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17297 kstart=ifrag(1,ipair(1,ii,iset),iset)
17298 kend=ifrag(2,ipair(1,ii,iset),iset)
17299 lstart=ifrag(1,ipair(2,ii,iset),iset)
17300 lend=ifrag(2,ipair(2,ii,iset),iset)
17301 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17302 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17305 dc(j,i)=cdummy(j,i)
17306 call chainbuild_cart
17309 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17311 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17315 kstart=ifrag(1,ipair(1,ii,iset),iset)
17316 kend=ifrag(2,ipair(1,ii,iset),iset)
17317 lstart=ifrag(1,ipair(2,ii,iset),iset)
17318 lend=ifrag(2,ipair(2,ii,iset),iset)
17319 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17320 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17323 ducartan(j,i)=(uzap2-uzap1)/(delta)
17326 ! Calculating numerical gradients for dU/ddx
17328 duxcartan(j,i)=0.0d0
17330 cdummy(j,i)=dc(j,i+nres)
17331 dc(j,i+nres)=dc(j,i+nres)+delta
17332 call chainbuild_cart
17335 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17337 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17341 kstart=ifrag(1,ipair(1,ii,iset),iset)
17342 kend=ifrag(2,ipair(1,ii,iset),iset)
17343 lstart=ifrag(1,ipair(2,ii,iset),iset)
17344 lend=ifrag(2,ipair(2,ii,iset),iset)
17345 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17346 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17349 dc(j,i+nres)=cdummy(j,i)
17350 call chainbuild_cart
17353 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17354 ifrag(2,ii,iset),.true.,idummy,idummy)
17355 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17359 kstart=ifrag(1,ipair(1,ii,iset),iset)
17360 kend=ifrag(2,ipair(1,ii,iset),iset)
17361 lstart=ifrag(1,ipair(2,ii,iset),iset)
17362 lend=ifrag(2,ipair(2,ii,iset),iset)
17363 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17364 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17367 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17370 write(iout,*) "Numerical dUconst/ddc backbone "
17372 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17374 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17376 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17379 end subroutine dEconstrQ_num
17380 !-----------------------------------------------------------------------------
17382 !-----------------------------------------------------------------------------
17383 subroutine check_energies
17385 ! use random, only: ran_number
17389 ! include 'DIMENSIONS'
17390 ! include 'COMMON.CHAIN'
17391 ! include 'COMMON.VAR'
17392 ! include 'COMMON.IOUNITS'
17393 ! include 'COMMON.SBRIDGE'
17394 ! include 'COMMON.LOCAL'
17395 ! include 'COMMON.GEO'
17397 ! External functions
17398 !EL double precision ran_number
17399 !EL external ran_number
17402 integer :: i,j,k,l,lmax,p,pmax
17403 real(kind=8) :: rmin,rmax
17404 real(kind=8) :: eij
17407 real(kind=8) :: wi,rij,tj,pj
17429 !t wi=ran_number(0.0D0,pi)
17430 ! wi=ran_number(0.0D0,pi/6.0D0)
17432 !t tj=ran_number(0.0D0,pi)
17433 !t pj=ran_number(0.0D0,pi)
17434 ! pj=ran_number(0.0D0,pi/6.0D0)
17438 !t rij=ran_number(rmin,rmax)
17440 c(1,j)=d*sin(pj)*cos(tj)
17441 c(2,j)=d*sin(pj)*sin(tj)
17447 c(3,i)=-rij-d*cos(wi)
17450 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17451 dc_norm(k,nres+i)=dc(k,nres+i)/d
17452 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17453 dc_norm(k,nres+j)=dc(k,nres+j)/d
17456 call dyn_ssbond_ene(i,j,eij)
17461 end subroutine check_energies
17462 !-----------------------------------------------------------------------------
17463 subroutine dyn_ssbond_ene(resi,resj,eij)
17468 ! include 'DIMENSIONS'
17469 ! include 'COMMON.SBRIDGE'
17470 ! include 'COMMON.CHAIN'
17471 ! include 'COMMON.DERIV'
17472 ! include 'COMMON.LOCAL'
17473 ! include 'COMMON.INTERACT'
17474 ! include 'COMMON.VAR'
17475 ! include 'COMMON.IOUNITS'
17476 ! include 'COMMON.CALC'
17480 ! include 'COMMON.MD'
17481 ! use MD, only: totT,t_bath
17484 ! External functions
17485 !EL double precision h_base
17486 !EL external h_base
17489 integer :: resi,resj
17492 real(kind=8) :: eij
17495 logical :: havebond
17496 integer itypi,itypj
17497 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17498 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17499 real(kind=8),dimension(3) :: dcosom1,dcosom2
17501 real(kind=8) :: pom1,pom2
17502 real(kind=8) :: ljA,ljB,ljXs
17503 real(kind=8),dimension(1:3) :: d_ljB
17504 real(kind=8) :: ssA,ssB,ssC,ssXs
17505 real(kind=8) :: ssxm,ljxm,ssm,ljm
17506 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17507 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17508 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17509 !-------FIRST METHOD
17511 real(kind=8),dimension(1:3) :: d_xm
17512 !-------END FIRST METHOD
17513 !-------SECOND METHOD
17514 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17515 !-------END SECOND METHOD
17517 !-------TESTING CODE
17518 !el logical :: checkstop,transgrad
17519 !el common /sschecks/ checkstop,transgrad
17521 integer :: icheck,nicheck,jcheck,njcheck
17522 real(kind=8),dimension(-1:1) :: echeck
17523 real(kind=8) :: deps,ssx0,ljx0
17524 !-------END TESTING CODE
17530 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17531 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17534 dxi=dc_norm(1,nres+i)
17535 dyi=dc_norm(2,nres+i)
17536 dzi=dc_norm(3,nres+i)
17537 dsci_inv=vbld_inv(i+nres)
17540 xj=c(1,nres+j)-c(1,nres+i)
17541 yj=c(2,nres+j)-c(2,nres+i)
17542 zj=c(3,nres+j)-c(3,nres+i)
17543 dxj=dc_norm(1,nres+j)
17544 dyj=dc_norm(2,nres+j)
17545 dzj=dc_norm(3,nres+j)
17546 dscj_inv=vbld_inv(j+nres)
17548 chi1=chi(itypi,itypj)
17549 chi2=chi(itypj,itypi)
17556 alf12=0.5D0*(alf1+alf2)
17558 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17559 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17560 ! The following are set in sc_angular
17564 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17565 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17566 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17568 rij=1.0D0/rij ! Reset this so it makes sense
17570 sig0ij=sigma(itypi,itypj)
17571 sig=sig0ij*dsqrt(1.0D0/sigsq)
17574 ljA=eps1*eps2rt**2*eps3rt**2
17575 ljB=ljA*bb_aq(itypi,itypj)
17576 ljA=ljA*aa_aq(itypi,itypj)
17577 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17582 deltat12=om2-om1+2.0d0
17583 cosphi=om12-om1*om2
17587 +akth*(deltat1*deltat1+deltat2*deltat2) &
17588 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17589 ssxm=ssXs-0.5D0*ssB/ssA
17591 !-------TESTING CODE
17592 !$$$c Some extra output
17593 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17594 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17595 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17596 !$$$ if (ssx0.gt.0.0d0) then
17597 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17601 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17602 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17603 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17605 !-------END TESTING CODE
17607 !-------TESTING CODE
17608 ! Stop and plot energy and derivative as a function of distance
17609 if (checkstop) then
17610 ssm=ssC-0.25D0*ssB*ssB/ssA
17611 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17612 if (ssm.lt.ljm .and. &
17613 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17621 if (.not.checkstop) then
17626 do icheck=0,nicheck
17627 do jcheck=-1,njcheck
17628 if (checkstop) rij=(ssxm-1.0d0)+ &
17629 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17630 !-------END TESTING CODE
17632 if (rij.gt.ljxm) then
17635 fac=(1.0D0/ljd)**expon
17636 e1=fac*fac*aa_aq(itypi,itypj)
17637 e2=fac*bb_aq(itypi,itypj)
17638 eij=eps1*eps2rt*eps3rt*(e1+e2)
17641 eij=eij*eps2rt*eps3rt
17644 e1=e1*eps1*eps2rt**2*eps3rt**2
17645 ed=-expon*(e1+eij)/ljd
17647 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17648 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17649 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17650 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17651 else if (rij.lt.ssxm) then
17654 eij=ssA*ssd*ssd+ssB*ssd+ssC
17656 ed=2*akcm*ssd+akct*deltat12
17658 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17659 eom1=-2*akth*deltat1-pom1-om2*pom2
17660 eom2= 2*akth*deltat2+pom1-om1*pom2
17663 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17665 d_ssxm(1)=0.5D0*akct/ssA
17666 d_ssxm(2)=-d_ssxm(1)
17669 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
17670 d_ljxm(2)=d_ljxm(1)*sigsq_om2
17671 d_ljxm(3)=d_ljxm(1)*sigsq_om12
17672 d_ljxm(1)=d_ljxm(1)*sigsq_om1
17674 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17675 xm=0.5d0*(ssxm+ljxm)
17677 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
17679 if (rij.lt.xm) then
17681 ssm=ssC-0.25D0*ssB*ssB/ssA
17682 d_ssm(1)=0.5D0*akct*ssB/ssA
17683 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17684 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17686 f1=(rij-xm)/(ssxm-xm)
17687 f2=(rij-ssxm)/(xm-ssxm)
17691 delta_inv=1.0d0/(xm-ssxm)
17692 deltasq_inv=delta_inv*delta_inv
17694 fac1=deltasq_inv*fac*(xm-rij)
17695 fac2=deltasq_inv*fac*(rij-ssxm)
17696 ed=delta_inv*(Ht*hd2-ssm*hd1)
17697 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
17698 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
17699 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
17702 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17703 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
17704 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
17705 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
17707 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
17708 f1=(rij-ljxm)/(xm-ljxm)
17709 f2=(rij-xm)/(ljxm-xm)
17713 delta_inv=1.0d0/(ljxm-xm)
17714 deltasq_inv=delta_inv*delta_inv
17716 fac1=deltasq_inv*fac*(ljxm-rij)
17717 fac2=deltasq_inv*fac*(rij-xm)
17718 ed=delta_inv*(ljm*hd2-Ht*hd1)
17719 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
17720 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
17721 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
17723 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17725 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17731 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
17732 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
17733 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
17735 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17736 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
17737 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17738 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17739 !$$$ d_ssm(3)=omega
17741 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
17743 !$$$ d_ljm(k)=ljm*d_ljB(k)
17747 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
17748 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
17749 !$$$ d_ss(2)=akct*ssd
17750 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
17751 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
17754 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
17755 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
17756 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
17758 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
17759 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
17761 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
17763 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
17764 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
17765 !$$$ h1=h_base(f1,hd1)
17766 !$$$ h2=h_base(f2,hd2)
17767 !$$$ eij=ss*h1+ljf*h2
17768 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
17769 !$$$ deltasq_inv=delta_inv*delta_inv
17770 !$$$ fac=ljf*hd2-ss*hd1
17771 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
17772 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
17773 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
17774 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
17775 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
17776 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
17777 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
17779 !$$$ havebond=.false.
17780 !$$$ if (ed.gt.0.0d0) havebond=.true.
17781 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17788 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
17789 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17790 ! & "SSBOND_E_FORM",totT,t_bath,i,j
17794 dyn_ssbond_ij(i,j)=eij
17795 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
17796 dyn_ssbond_ij(i,j)=1.0d300
17799 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17800 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
17805 !-------TESTING CODE
17806 !el if (checkstop) then
17807 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
17808 "CHECKSTOP",rij,eij,ed
17812 if (checkstop) then
17813 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
17816 if (checkstop) then
17820 !-------END TESTING CODE
17823 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
17824 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
17827 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
17830 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
17831 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
17832 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
17833 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
17834 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
17835 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
17839 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
17844 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17845 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17849 end subroutine dyn_ssbond_ene
17850 !--------------------------------------------------------------------------
17851 subroutine triple_ssbond_ene(resi,resj,resk,eij)
17856 ! include 'DIMENSIONS'
17857 ! include 'COMMON.SBRIDGE'
17858 ! include 'COMMON.CHAIN'
17859 ! include 'COMMON.DERIV'
17860 ! include 'COMMON.LOCAL'
17861 ! include 'COMMON.INTERACT'
17862 ! include 'COMMON.VAR'
17863 ! include 'COMMON.IOUNITS'
17864 ! include 'COMMON.CALC'
17868 ! include 'COMMON.MD'
17869 ! use MD, only: totT,t_bath
17872 double precision h_base
17876 integer resi,resj,resk,m,itypi,itypj,itypk
17878 !c Output arguments
17879 double precision eij,eij1,eij2,eij3
17883 !c integer itypi,itypj,k,l
17884 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
17885 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
17886 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
17887 double precision sig0ij,ljd,sig,fac,e1,e2
17888 double precision dcosom1(3),dcosom2(3),ed
17889 double precision pom1,pom2
17890 double precision ljA,ljB,ljXs
17891 double precision d_ljB(1:3)
17892 double precision ssA,ssB,ssC,ssXs
17893 double precision ssxm,ljxm,ssm,ljm
17894 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
17896 if (dtriss.eq.0) return
17900 !C write(iout,*) resi,resj,resk
17902 dxi=dc_norm(1,nres+i)
17903 dyi=dc_norm(2,nres+i)
17904 dzi=dc_norm(3,nres+i)
17905 dsci_inv=vbld_inv(i+nres)
17914 dxj=dc_norm(1,nres+j)
17915 dyj=dc_norm(2,nres+j)
17916 dzj=dc_norm(3,nres+j)
17917 dscj_inv=vbld_inv(j+nres)
17923 dxk=dc_norm(1,nres+k)
17924 dyk=dc_norm(2,nres+k)
17925 dzk=dc_norm(3,nres+k)
17926 dscj_inv=vbld_inv(k+nres)
17936 rrij=(xij*xij+yij*yij+zij*zij)
17937 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17938 rrik=(xik*xik+yik*yik+zik*zik)
17940 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
17942 !C there are three combination of distances for each trisulfide bonds
17943 !C The first case the ith atom is the center
17944 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
17945 !C distance y is second distance the a,b,c,d are parameters derived for
17946 !C this problem d parameter was set as a penalty currenlty set to 1.
17947 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
17950 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
17952 !C second case jth atom is center
17953 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
17956 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
17958 !C the third case kth atom is the center
17959 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
17962 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
17968 !C write(iout,*)i,j,k,eij
17969 !C The energy penalty calculated now time for the gradient part
17970 !C derivative over rij
17971 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
17972 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
17977 gvdwx(m,i)=gvdwx(m,i)-gg(m)
17978 gvdwx(m,j)=gvdwx(m,j)+gg(m)
17982 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17983 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17985 !C now derivative over rik
17986 fac=-eij1**2/dtriss* &
17987 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
17988 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
17993 gvdwx(m,i)=gvdwx(m,i)-gg(m)
17994 gvdwx(m,k)=gvdwx(m,k)+gg(m)
17997 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17998 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18000 !C now derivative over rjk
18001 fac=-eij2**2/dtriss* &
18002 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18003 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18008 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18009 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18012 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18013 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18016 end subroutine triple_ssbond_ene
18020 !-----------------------------------------------------------------------------
18021 real(kind=8) function h_base(x,deriv)
18022 ! A smooth function going 0->1 in range [0,1]
18023 ! It should NOT be called outside range [0,1], it will not work there.
18030 real(kind=8) :: deriv
18033 real(kind=8) :: xsq
18036 ! Two parabolas put together. First derivative zero at extrema
18037 !$$$ if (x.lt.0.5D0) then
18038 !$$$ h_base=2.0D0*x*x
18042 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18043 !$$$ deriv=4.0D0*deriv
18046 ! Third degree polynomial. First derivative zero at extrema
18047 h_base=x*x*(3.0d0-2.0d0*x)
18048 deriv=6.0d0*x*(1.0d0-x)
18050 ! Fifth degree polynomial. First and second derivatives zero at extrema
18052 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18054 !$$$ deriv=deriv*deriv
18055 !$$$ deriv=30.0d0*xsq*deriv
18058 end function h_base
18059 !-----------------------------------------------------------------------------
18060 subroutine dyn_set_nss
18061 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18063 use MD_data, only: totT,t_bath
18065 ! include 'DIMENSIONS'
18069 ! include 'COMMON.SBRIDGE'
18070 ! include 'COMMON.CHAIN'
18071 ! include 'COMMON.IOUNITS'
18072 ! include 'COMMON.SETUP'
18073 ! include 'COMMON.MD'
18075 real(kind=8) :: emin
18076 integer :: i,j,imin,ierr
18077 integer :: diff,allnss,newnss
18078 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18081 integer,dimension(0:nfgtasks) :: i_newnss
18082 integer,dimension(0:nfgtasks) :: displ
18083 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18084 integer :: g_newnss
18089 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18098 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18102 if (allflag(i).eq.0 .and. &
18103 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18104 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18108 if (emin.lt.1.0d300) then
18111 if (allflag(i).eq.0 .and. &
18112 (allihpb(i).eq.allihpb(imin) .or. &
18113 alljhpb(i).eq.allihpb(imin) .or. &
18114 allihpb(i).eq.alljhpb(imin) .or. &
18115 alljhpb(i).eq.alljhpb(imin))) then
18122 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18126 if (allflag(i).eq.1) then
18128 newihpb(newnss)=allihpb(i)
18129 newjhpb(newnss)=alljhpb(i)
18134 if (nfgtasks.gt.1)then
18136 call MPI_Reduce(newnss,g_newnss,1,&
18137 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18138 call MPI_Gather(newnss,1,MPI_INTEGER,&
18139 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18141 do i=1,nfgtasks-1,1
18142 displ(i)=i_newnss(i-1)+displ(i-1)
18144 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18145 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18147 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18148 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18150 if(fg_rank.eq.0) then
18151 ! print *,'g_newnss',g_newnss
18152 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18153 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18156 newihpb(i)=g_newihpb(i)
18157 newjhpb(i)=g_newjhpb(i)
18165 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18166 ! print *,newnss,nss,maxdim
18172 if (idssb(i).eq.newihpb(j) .and. &
18173 jdssb(i).eq.newjhpb(j)) found=.true.
18177 ! write(iout,*) "found",found,i,j
18178 if (.not.found.and.fg_rank.eq.0) &
18179 write(iout,'(a15,f12.2,f8.1,2i5)') &
18180 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18189 if (newihpb(i).eq.idssb(j) .and. &
18190 newjhpb(i).eq.jdssb(j)) found=.true.
18194 ! write(iout,*) "found",found,i,j
18195 if (.not.found.and.fg_rank.eq.0) &
18196 write(iout,'(a15,f12.2,f8.1,2i5)') &
18197 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18204 idssb(i)=newihpb(i)
18205 jdssb(i)=newjhpb(i)
18209 end subroutine dyn_set_nss
18210 ! Lipid transfer energy function
18211 subroutine Eliptransfer(eliptran)
18212 !C this is done by Adasko
18213 !C print *,"wchodze"
18214 !C structure of box:
18216 !C--bordliptop-- buffore starts
18217 !C--bufliptop--- here true lipid starts
18219 !C--buflipbot--- lipid ends buffore starts
18220 !C--bordlipbot--buffore ends
18221 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18224 ! print *, "I am in eliptran"
18225 do i=ilip_start,ilip_end
18227 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18230 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18231 if (positi.le.0.0) positi=positi+boxzsize
18233 !C first for peptide groups
18234 !c for each residue check if it is in lipid or lipid water border area
18235 if ((positi.gt.bordlipbot) &
18236 .and.(positi.lt.bordliptop)) then
18237 !C the energy transfer exist
18238 if (positi.lt.buflipbot) then
18239 !C what fraction I am in
18241 ((positi-bordlipbot)/lipbufthick)
18242 !C lipbufthick is thickenes of lipid buffore
18243 sslip=sscalelip(fracinbuf)
18244 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18245 eliptran=eliptran+sslip*pepliptran
18246 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18247 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18248 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18250 !C print *,"doing sccale for lower part"
18251 !C print *,i,sslip,fracinbuf,ssgradlip
18252 elseif (positi.gt.bufliptop) then
18253 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18254 sslip=sscalelip(fracinbuf)
18255 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18256 eliptran=eliptran+sslip*pepliptran
18257 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18258 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18259 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18260 !C print *, "doing sscalefor top part"
18261 !C print *,i,sslip,fracinbuf,ssgradlip
18263 eliptran=eliptran+pepliptran
18264 !C print *,"I am in true lipid"
18267 !C eliptran=elpitran+0.0 ! I am in water
18269 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18271 ! here starts the side chain transfer
18272 do i=ilip_start,ilip_end
18273 if (itype(i,1).eq.ntyp1) cycle
18274 positi=(mod(c(3,i+nres),boxzsize))
18275 if (positi.le.0) positi=positi+boxzsize
18276 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18277 !c for each residue check if it is in lipid or lipid water border area
18278 !C respos=mod(c(3,i+nres),boxzsize)
18279 !C print *,positi,bordlipbot,buflipbot
18280 if ((positi.gt.bordlipbot) &
18281 .and.(positi.lt.bordliptop)) then
18282 !C the energy transfer exist
18283 if (positi.lt.buflipbot) then
18285 ((positi-bordlipbot)/lipbufthick)
18286 !C lipbufthick is thickenes of lipid buffore
18287 sslip=sscalelip(fracinbuf)
18288 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18289 eliptran=eliptran+sslip*liptranene(itype(i,1))
18290 gliptranx(3,i)=gliptranx(3,i) &
18291 +ssgradlip*liptranene(itype(i,1))
18292 gliptranc(3,i-1)= gliptranc(3,i-1) &
18293 +ssgradlip*liptranene(itype(i,1))
18294 !C print *,"doing sccale for lower part"
18295 elseif (positi.gt.bufliptop) then
18297 ((bordliptop-positi)/lipbufthick)
18298 sslip=sscalelip(fracinbuf)
18299 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18300 eliptran=eliptran+sslip*liptranene(itype(i,1))
18301 gliptranx(3,i)=gliptranx(3,i) &
18302 +ssgradlip*liptranene(itype(i,1))
18303 gliptranc(3,i-1)= gliptranc(3,i-1) &
18304 +ssgradlip*liptranene(itype(i,1))
18305 !C print *, "doing sscalefor top part",sslip,fracinbuf
18307 eliptran=eliptran+liptranene(itype(i,1))
18308 !C print *,"I am in true lipid"
18310 endif ! if in lipid or buffor
18312 !C eliptran=elpitran+0.0 ! I am in water
18313 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18316 end subroutine Eliptransfer
18317 !----------------------------------NANO FUNCTIONS
18318 !C-----------------------------------------------------------------------
18319 !C-----------------------------------------------------------
18320 !C This subroutine is to mimic the histone like structure but as well can be
18321 !C utilizet to nanostructures (infinit) small modification has to be used to
18322 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18323 !C gradient has to be modified at the ends
18324 !C The energy function is Kihara potential
18325 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18326 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18327 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18328 !C simple Kihara potential
18329 subroutine calctube(Etube)
18330 real(kind=8) :: vectube(3),enetube(nres*2)
18331 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18332 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18333 sc_aa_tube,sc_bb_tube
18336 do i=itube_start,itube_end
18338 enetube(i+nres)=0.0d0
18340 !C first we calculate the distance from tube center
18342 do i=itube_start,itube_end
18343 !C lets ommit dummy atoms for now
18344 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18345 !C now calculate distance from center of tube and direction vectors
18348 ! Find minimum distance in periodic box
18350 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18351 vectube(1)=vectube(1)+boxxsize*j
18352 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18353 vectube(2)=vectube(2)+boxysize*j
18354 xminact=abs(vectube(1)-tubecenter(1))
18355 yminact=abs(vectube(2)-tubecenter(2))
18356 if (xmin.gt.xminact) then
18360 if (ymin.gt.yminact) then
18367 vectube(1)=vectube(1)-tubecenter(1)
18368 vectube(2)=vectube(2)-tubecenter(2)
18370 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18371 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18373 !C as the tube is infinity we do not calculate the Z-vector use of Z
18376 !C now calculte the distance
18377 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18378 !C now normalize vector
18379 vectube(1)=vectube(1)/tub_r
18380 vectube(2)=vectube(2)/tub_r
18381 !C calculte rdiffrence between r and r0
18384 rdiff6=rdiff**6.0d0
18385 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18386 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18387 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18388 !C print *,rdiff,rdiff6,pep_aa_tube
18389 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18390 !C now we calculate gradient
18391 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18392 6.0d0*pep_bb_tube)/rdiff6/rdiff
18393 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18395 !C now direction of gg_tube vector
18397 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18398 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18401 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18402 !C print *,gg_tube(1,0),"TU"
18405 do i=itube_start,itube_end
18406 !C Lets not jump over memory as we use many times iti
18408 !C lets ommit dummy atoms for now
18409 if ((iti.eq.ntyp1) &
18410 !C in UNRES uncomment the line below as GLY has no side-chain...
18416 vectube(1)=mod((c(1,i+nres)),boxxsize)
18417 vectube(1)=vectube(1)+boxxsize*j
18418 vectube(2)=mod((c(2,i+nres)),boxysize)
18419 vectube(2)=vectube(2)+boxysize*j
18421 xminact=abs(vectube(1)-tubecenter(1))
18422 yminact=abs(vectube(2)-tubecenter(2))
18423 if (xmin.gt.xminact) then
18427 if (ymin.gt.yminact) then
18434 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18436 vectube(1)=vectube(1)-tubecenter(1)
18437 vectube(2)=vectube(2)-tubecenter(2)
18439 !C as the tube is infinity we do not calculate the Z-vector use of Z
18442 !C now calculte the distance
18443 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18444 !C now normalize vector
18445 vectube(1)=vectube(1)/tub_r
18446 vectube(2)=vectube(2)/tub_r
18448 !C calculte rdiffrence between r and r0
18451 rdiff6=rdiff**6.0d0
18452 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18453 sc_aa_tube=sc_aa_tube_par(iti)
18454 sc_bb_tube=sc_bb_tube_par(iti)
18455 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18456 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18457 6.0d0*sc_bb_tube/rdiff6/rdiff
18458 !C now direction of gg_tube vector
18460 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18461 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18464 do i=itube_start,itube_end
18465 Etube=Etube+enetube(i)+enetube(i+nres)
18467 !C print *,"ETUBE", etube
18469 end subroutine calctube
18470 !C TO DO 1) add to total energy
18471 !C 2) add to gradient summation
18472 !C 3) add reading parameters (AND of course oppening of PARAM file)
18473 !C 4) add reading the center of tube
18475 !C 6) add to zerograd
18476 !C 7) allocate matrices
18479 !C-----------------------------------------------------------------------
18480 !C-----------------------------------------------------------
18481 !C This subroutine is to mimic the histone like structure but as well can be
18482 !C utilizet to nanostructures (infinit) small modification has to be used to
18483 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18484 !C gradient has to be modified at the ends
18485 !C The energy function is Kihara potential
18486 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18487 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18488 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18489 !C simple Kihara potential
18490 subroutine calctube2(Etube)
18491 real(kind=8) :: vectube(3),enetube(nres*2)
18492 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18493 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18494 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18497 do i=itube_start,itube_end
18499 enetube(i+nres)=0.0d0
18501 !C first we calculate the distance from tube center
18502 !C first sugare-phosphate group for NARES this would be peptide group
18504 do i=itube_start,itube_end
18505 !C lets ommit dummy atoms for now
18507 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18508 !C now calculate distance from center of tube and direction vectors
18509 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18510 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18511 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18512 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18516 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18517 vectube(1)=vectube(1)+boxxsize*j
18518 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18519 vectube(2)=vectube(2)+boxysize*j
18521 xminact=abs(vectube(1)-tubecenter(1))
18522 yminact=abs(vectube(2)-tubecenter(2))
18523 if (xmin.gt.xminact) then
18527 if (ymin.gt.yminact) then
18534 vectube(1)=vectube(1)-tubecenter(1)
18535 vectube(2)=vectube(2)-tubecenter(2)
18537 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18538 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18540 !C as the tube is infinity we do not calculate the Z-vector use of Z
18543 !C now calculte the distance
18544 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18545 !C now normalize vector
18546 vectube(1)=vectube(1)/tub_r
18547 vectube(2)=vectube(2)/tub_r
18548 !C calculte rdiffrence between r and r0
18551 rdiff6=rdiff**6.0d0
18552 !C THIS FRAGMENT MAKES TUBE FINITE
18553 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18554 if (positi.le.0) positi=positi+boxzsize
18555 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18556 !c for each residue check if it is in lipid or lipid water border area
18557 !C respos=mod(c(3,i+nres),boxzsize)
18558 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18559 if ((positi.gt.bordtubebot) &
18560 .and.(positi.lt.bordtubetop)) then
18561 !C the energy transfer exist
18562 if (positi.lt.buftubebot) then
18564 ((positi-bordtubebot)/tubebufthick)
18565 !C lipbufthick is thickenes of lipid buffore
18566 sstube=sscalelip(fracinbuf)
18567 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18568 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18569 enetube(i)=enetube(i)+sstube*tubetranenepep
18570 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18571 !C &+ssgradtube*tubetranene(itype(i,1))
18572 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18573 !C &+ssgradtube*tubetranene(itype(i,1))
18574 !C print *,"doing sccale for lower part"
18575 elseif (positi.gt.buftubetop) then
18577 ((bordtubetop-positi)/tubebufthick)
18578 sstube=sscalelip(fracinbuf)
18579 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18580 enetube(i)=enetube(i)+sstube*tubetranenepep
18581 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18582 !C &+ssgradtube*tubetranene(itype(i,1))
18583 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18584 !C &+ssgradtube*tubetranene(itype(i,1))
18585 !C print *, "doing sscalefor top part",sslip,fracinbuf
18589 enetube(i)=enetube(i)+sstube*tubetranenepep
18590 !C print *,"I am in true lipid"
18594 !C ssgradtube=0.0d0
18596 endif ! if in lipid or buffor
18598 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18599 enetube(i)=enetube(i)+sstube* &
18600 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18601 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18602 !C print *,rdiff,rdiff6,pep_aa_tube
18603 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18604 !C now we calculate gradient
18605 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18606 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18607 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18610 !C now direction of gg_tube vector
18612 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18613 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18615 gg_tube(3,i)=gg_tube(3,i) &
18616 +ssgradtube*enetube(i)/sstube/2.0d0
18617 gg_tube(3,i-1)= gg_tube(3,i-1) &
18618 +ssgradtube*enetube(i)/sstube/2.0d0
18621 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18622 !C print *,gg_tube(1,0),"TU"
18623 do i=itube_start,itube_end
18624 !C Lets not jump over memory as we use many times iti
18626 !C lets ommit dummy atoms for now
18627 if ((iti.eq.ntyp1) &
18628 !!C in UNRES uncomment the line below as GLY has no side-chain...
18631 vectube(1)=c(1,i+nres)
18632 vectube(1)=mod(vectube(1),boxxsize)
18633 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18634 vectube(2)=c(2,i+nres)
18635 vectube(2)=mod(vectube(2),boxysize)
18636 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18638 vectube(1)=vectube(1)-tubecenter(1)
18639 vectube(2)=vectube(2)-tubecenter(2)
18640 !C THIS FRAGMENT MAKES TUBE FINITE
18641 positi=(mod(c(3,i+nres),boxzsize))
18642 if (positi.le.0) positi=positi+boxzsize
18643 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18644 !c for each residue check if it is in lipid or lipid water border area
18645 !C respos=mod(c(3,i+nres),boxzsize)
18646 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18648 if ((positi.gt.bordtubebot) &
18649 .and.(positi.lt.bordtubetop)) then
18650 !C the energy transfer exist
18651 if (positi.lt.buftubebot) then
18653 ((positi-bordtubebot)/tubebufthick)
18654 !C lipbufthick is thickenes of lipid buffore
18655 sstube=sscalelip(fracinbuf)
18656 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18657 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18658 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18659 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18660 !C &+ssgradtube*tubetranene(itype(i,1))
18661 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18662 !C &+ssgradtube*tubetranene(itype(i,1))
18663 !C print *,"doing sccale for lower part"
18664 elseif (positi.gt.buftubetop) then
18666 ((bordtubetop-positi)/tubebufthick)
18668 sstube=sscalelip(fracinbuf)
18669 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18670 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18671 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18672 !C &+ssgradtube*tubetranene(itype(i,1))
18673 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18674 !C &+ssgradtube*tubetranene(itype(i,1))
18675 !C print *, "doing sscalefor top part",sslip,fracinbuf
18679 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18680 !C print *,"I am in true lipid"
18684 !C ssgradtube=0.0d0
18686 endif ! if in lipid or buffor
18687 !CEND OF FINITE FRAGMENT
18688 !C as the tube is infinity we do not calculate the Z-vector use of Z
18691 !C now calculte the distance
18692 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18693 !C now normalize vector
18694 vectube(1)=vectube(1)/tub_r
18695 vectube(2)=vectube(2)/tub_r
18696 !C calculte rdiffrence between r and r0
18699 rdiff6=rdiff**6.0d0
18700 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18701 sc_aa_tube=sc_aa_tube_par(iti)
18702 sc_bb_tube=sc_bb_tube_par(iti)
18703 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
18704 *sstube+enetube(i+nres)
18705 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18706 !C now we calculate gradient
18707 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
18708 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
18709 !C now direction of gg_tube vector
18711 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18712 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18714 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
18715 +ssgradtube*enetube(i+nres)/sstube
18716 gg_tube(3,i-1)= gg_tube(3,i-1) &
18717 +ssgradtube*enetube(i+nres)/sstube
18720 do i=itube_start,itube_end
18721 Etube=Etube+enetube(i)+enetube(i+nres)
18723 !C print *,"ETUBE", etube
18725 end subroutine calctube2
18726 !=====================================================================================================================================
18727 subroutine calcnano(Etube)
18728 real(kind=8) :: vectube(3),enetube(nres*2), &
18730 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18731 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
18732 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
18736 ! print *,itube_start,itube_end,"poczatek"
18737 do i=itube_start,itube_end
18739 enetube(i+nres)=0.0d0
18741 !C first we calculate the distance from tube center
18742 !C first sugare-phosphate group for NARES this would be peptide group
18744 do i=itube_start,itube_end
18745 !C lets ommit dummy atoms for now
18746 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18747 !C now calculate distance from center of tube and direction vectors
18753 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18754 vectube(1)=vectube(1)+boxxsize*j
18755 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18756 vectube(2)=vectube(2)+boxysize*j
18757 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18758 vectube(3)=vectube(3)+boxzsize*j
18761 xminact=dabs(vectube(1)-tubecenter(1))
18762 yminact=dabs(vectube(2)-tubecenter(2))
18763 zminact=dabs(vectube(3)-tubecenter(3))
18765 if (xmin.gt.xminact) then
18769 if (ymin.gt.yminact) then
18773 if (zmin.gt.zminact) then
18782 vectube(1)=vectube(1)-tubecenter(1)
18783 vectube(2)=vectube(2)-tubecenter(2)
18784 vectube(3)=vectube(3)-tubecenter(3)
18786 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18787 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18788 !C as the tube is infinity we do not calculate the Z-vector use of Z
18790 !C vectube(3)=0.0d0
18791 !C now calculte the distance
18792 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18793 !C now normalize vector
18794 vectube(1)=vectube(1)/tub_r
18795 vectube(2)=vectube(2)/tub_r
18796 vectube(3)=vectube(3)/tub_r
18797 !C calculte rdiffrence between r and r0
18800 rdiff6=rdiff**6.0d0
18801 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18802 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18803 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18804 !C print *,rdiff,rdiff6,pep_aa_tube
18805 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18806 !C now we calculate gradient
18807 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18808 6.0d0*pep_bb_tube)/rdiff6/rdiff
18809 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18811 if (acavtubpep.eq.0.0d0) then
18816 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
18818 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
18821 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
18822 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
18823 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
18824 /denominator**2.0d0
18831 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18832 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18836 do i=itube_start,itube_end
18837 enecavtube(i)=0.0d0
18838 !C Lets not jump over memory as we use many times iti
18840 !C lets ommit dummy atoms for now
18841 if ((iti.eq.ntyp1) &
18842 !C in UNRES uncomment the line below as GLY has no side-chain...
18849 vectube(1)=dmod((c(1,i+nres)),boxxsize)
18850 vectube(1)=vectube(1)+boxxsize*j
18851 vectube(2)=dmod((c(2,i+nres)),boxysize)
18852 vectube(2)=vectube(2)+boxysize*j
18853 vectube(3)=dmod((c(3,i+nres)),boxzsize)
18854 vectube(3)=vectube(3)+boxzsize*j
18857 xminact=dabs(vectube(1)-tubecenter(1))
18858 yminact=dabs(vectube(2)-tubecenter(2))
18859 zminact=dabs(vectube(3)-tubecenter(3))
18861 if (xmin.gt.xminact) then
18865 if (ymin.gt.yminact) then
18869 if (zmin.gt.zminact) then
18878 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18880 vectube(1)=vectube(1)-tubecenter(1)
18881 vectube(2)=vectube(2)-tubecenter(2)
18882 vectube(3)=vectube(3)-tubecenter(3)
18883 !C now calculte the distance
18884 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18885 !C now normalize vector
18886 vectube(1)=vectube(1)/tub_r
18887 vectube(2)=vectube(2)/tub_r
18888 vectube(3)=vectube(3)/tub_r
18890 !C calculte rdiffrence between r and r0
18893 rdiff6=rdiff**6.0d0
18894 sc_aa_tube=sc_aa_tube_par(iti)
18895 sc_bb_tube=sc_bb_tube_par(iti)
18896 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18897 !C enetube(i+nres)=0.0d0
18898 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18899 !C now we calculate gradient
18900 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18901 6.0d0*sc_bb_tube/rdiff6/rdiff
18903 !C now direction of gg_tube vector
18904 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
18905 if (acavtub(iti).eq.0.0d0) then
18907 enecavtube(i+nres)=0.0d0
18910 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
18911 enecavtube(i+nres)= &
18912 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
18914 !C enecavtube(i)=0.0
18915 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
18916 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
18917 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
18918 /denominator**2.0d0
18923 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
18924 !C & enecavtube(i),faccav
18925 !C print *,"licz=",
18926 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
18927 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
18929 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18930 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18936 do i=itube_start,itube_end
18937 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
18938 +enecavtube(i+nres)
18940 !C print *,"ETUBE", etube
18942 end subroutine calcnano
18944 !===============================================
18945 !--------------------------------------------------------------------------------
18946 !C first for shielding is setting of function of side-chains
18948 subroutine set_shield_fac2
18949 real(kind=8) :: div77_81=0.974996043d0, &
18950 div4_81=0.2222222222d0
18951 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
18952 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
18953 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
18954 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
18955 !C the vector between center of side_chain and peptide group
18956 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
18957 pept_group,costhet_grad,cosphi_grad_long, &
18958 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
18959 sh_frac_dist_grad,pep_side
18961 !C write(2,*) "ivec",ivec_start,ivec_end
18963 fac_shield(i)=0.0d0
18965 grad_shield(j,i)=0.0d0
18968 do i=ivec_start,ivec_end
18970 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
18972 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
18973 !Cif there two consequtive dummy atoms there is no peptide group between them
18974 !C the line below has to be changed for FGPROC>1
18977 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
18981 !C first lets set vector conecting the ithe side-chain with kth side-chain
18982 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
18983 !C pep_side(j)=2.0d0
18984 !C and vector conecting the side-chain with its proper calfa
18985 side_calf(j)=c(j,k+nres)-c(j,k)
18986 !C side_calf(j)=2.0d0
18987 pept_group(j)=c(j,i)-c(j,i+1)
18988 !C lets have their lenght
18989 dist_pep_side=pep_side(j)**2+dist_pep_side
18990 dist_side_calf=dist_side_calf+side_calf(j)**2
18991 dist_pept_group=dist_pept_group+pept_group(j)**2
18993 dist_pep_side=sqrt(dist_pep_side)
18994 dist_pept_group=sqrt(dist_pept_group)
18995 dist_side_calf=sqrt(dist_side_calf)
18997 pep_side_norm(j)=pep_side(j)/dist_pep_side
18998 side_calf_norm(j)=dist_side_calf
19000 !C now sscale fraction
19001 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19002 !C print *,buff_shield,"buff"
19004 if (sh_frac_dist.le.0.0) cycle
19005 !C print *,ishield_list(i),i
19006 !C If we reach here it means that this side chain reaches the shielding sphere
19007 !C Lets add him to the list for gradient
19008 ishield_list(i)=ishield_list(i)+1
19009 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19010 !C this list is essential otherwise problem would be O3
19011 shield_list(ishield_list(i),i)=k
19012 !C Lets have the sscale value
19013 if (sh_frac_dist.gt.1.0) then
19014 scale_fac_dist=1.0d0
19016 sh_frac_dist_grad(j)=0.0d0
19019 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19020 *(2.0d0*sh_frac_dist-3.0d0)
19021 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19022 /dist_pep_side/buff_shield*0.5d0
19024 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19025 !C sh_frac_dist_grad(j)=0.0d0
19026 !C scale_fac_dist=1.0d0
19027 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19028 !C & sh_frac_dist_grad(j)
19031 !C this is what is now we have the distance scaling now volume...
19032 short=short_r_sidechain(itype(k,1))
19033 long=long_r_sidechain(itype(k,1))
19034 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19035 sinthet=short/dist_pep_side*costhet
19036 !C now costhet_grad
19039 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19040 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19041 !C & -short/dist_pep_side**2/costhet)
19042 !C costhet_fac=0.0d0
19044 costhet_grad(j)=costhet_fac*pep_side(j)
19046 !C remember for the final gradient multiply costhet_grad(j)
19047 !C for side_chain by factor -2 !
19048 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19049 !C pep_side0pept_group is vector multiplication
19050 pep_side0pept_group=0.0d0
19052 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19054 cosalfa=(pep_side0pept_group/ &
19055 (dist_pep_side*dist_side_calf))
19056 fac_alfa_sin=1.0d0-cosalfa**2
19057 fac_alfa_sin=dsqrt(fac_alfa_sin)
19058 rkprim=fac_alfa_sin*(long-short)+short
19061 !C now costhet_grad
19062 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19064 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19065 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19069 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19070 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19071 *(long-short)/fac_alfa_sin*cosalfa/ &
19072 ((dist_pep_side*dist_side_calf))* &
19073 ((side_calf(j))-cosalfa* &
19074 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19075 !C cosphi_grad_long(j)=0.0d0
19076 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19077 *(long-short)/fac_alfa_sin*cosalfa &
19078 /((dist_pep_side*dist_side_calf))* &
19080 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19081 !C cosphi_grad_loc(j)=0.0d0
19083 !C print *,sinphi,sinthet
19084 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19087 !C now the gradient...
19089 grad_shield(j,i)=grad_shield(j,i) &
19090 !C gradient po skalowaniu
19091 +(sh_frac_dist_grad(j)*VofOverlap &
19092 !C gradient po costhet
19093 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19094 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19095 sinphi/sinthet*costhet*costhet_grad(j) &
19096 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19098 !C grad_shield_side is Cbeta sidechain gradient
19099 grad_shield_side(j,ishield_list(i),i)=&
19100 (sh_frac_dist_grad(j)*-2.0d0&
19102 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19103 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19104 sinphi/sinthet*costhet*costhet_grad(j)&
19105 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19108 grad_shield_loc(j,ishield_list(i),i)= &
19109 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19110 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19111 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19115 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19117 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19119 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19122 end subroutine set_shield_fac2
19123 !----------------------------------------------------------------------------
19124 ! SOUBROUTINE FOR AFM
19125 subroutine AFMvel(Eafmforce)
19126 use MD_data, only:totTafm
19127 real(kind=8),dimension(3) :: diffafm
19128 real(kind=8) :: afmdist,Eafmforce
19130 !C Only for check grad COMMENT if not used for checkgrad
19132 !C--------------------------------------------------------
19133 !C print *,"wchodze"
19137 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19138 afmdist=afmdist+diffafm(i)**2
19140 afmdist=dsqrt(afmdist)
19142 Eafmforce=0.5d0*forceAFMconst &
19143 *(distafminit+totTafm*velAFMconst-afmdist)**2
19144 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19146 gradafm(i,afmend-1)=-forceAFMconst* &
19147 (distafminit+totTafm*velAFMconst-afmdist) &
19148 *diffafm(i)/afmdist
19149 gradafm(i,afmbeg-1)=forceAFMconst* &
19150 (distafminit+totTafm*velAFMconst-afmdist) &
19151 *diffafm(i)/afmdist
19153 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19155 end subroutine AFMvel
19156 !---------------------------------------------------------
19157 subroutine AFMforce(Eafmforce)
19159 real(kind=8),dimension(3) :: diffafm
19160 ! real(kind=8) ::afmdist
19161 real(kind=8) :: afmdist,Eafmforce
19166 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19167 afmdist=afmdist+diffafm(i)**2
19169 afmdist=dsqrt(afmdist)
19170 ! print *,afmdist,distafminit
19171 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19173 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19174 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19176 !C print *,'AFM',Eafmforce
19178 end subroutine AFMforce
19180 !-----------------------------------------------------------------------------
19182 subroutine read_ssHist
19185 ! include 'DIMENSIONS'
19186 ! include "DIMENSIONS.FREE"
19187 ! include 'COMMON.FREE'
19190 character(len=80) :: controlcard
19193 call card_concat(controlcard,.true.)
19194 read(controlcard,*) &
19195 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19199 end subroutine read_ssHist
19201 !-----------------------------------------------------------------------------
19202 integer function indmat(i,j)
19204 ! get the position of the jth ijth fragment of the chain coordinate system
19205 ! in the fromto array.
19208 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19210 end function indmat
19211 !-----------------------------------------------------------------------------
19212 real(kind=8) function sigm(x)
19218 !-----------------------------------------------------------------------------
19219 !-----------------------------------------------------------------------------
19220 subroutine alloc_ener_arrays
19221 !EL Allocation of arrays used by module energy
19222 use MD_data, only: mset
19223 !el local variables
19226 if(nres.lt.100) then
19228 elseif(nres.lt.200) then
19229 maxconts=0.8*nres ! Max. number of contacts per residue
19231 maxconts=0.6*nres ! (maxconts=maxres/4)
19233 maxcont=12*nres ! Max. number of SC contacts
19234 maxvar=6*nres ! Max. number of variables
19235 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19236 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19237 !----------------------
19238 ! arrays in subroutine init_int_table
19240 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19241 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19243 allocate(nint_gr(nres))
19244 allocate(nscp_gr(nres))
19245 allocate(ielstart(nres))
19246 allocate(ielend(nres))
19248 allocate(istart(nres,maxint_gr))
19249 allocate(iend(nres,maxint_gr))
19250 !(maxres,maxint_gr)
19251 allocate(iscpstart(nres,maxint_gr))
19252 allocate(iscpend(nres,maxint_gr))
19253 !(maxres,maxint_gr)
19254 allocate(ielstart_vdw(nres))
19255 allocate(ielend_vdw(nres))
19258 allocate(lentyp(0:nfgtasks-1))
19260 !----------------------
19262 ! common /contacts/
19263 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19264 allocate(icont(2,maxcont))
19266 ! common /contacts1/
19267 allocate(num_cont(0:nres+4))
19269 allocate(jcont(maxconts,nres))
19271 allocate(facont(maxconts,nres))
19273 allocate(gacont(3,maxconts,nres))
19274 !(3,maxconts,maxres)
19275 ! common /contacts_hb/
19276 allocate(gacontp_hb1(3,maxconts,nres))
19277 allocate(gacontp_hb2(3,maxconts,nres))
19278 allocate(gacontp_hb3(3,maxconts,nres))
19279 allocate(gacontm_hb1(3,maxconts,nres))
19280 allocate(gacontm_hb2(3,maxconts,nres))
19281 allocate(gacontm_hb3(3,maxconts,nres))
19282 allocate(gacont_hbr(3,maxconts,nres))
19283 allocate(grij_hb_cont(3,maxconts,nres))
19284 !(3,maxconts,maxres)
19285 allocate(facont_hb(maxconts,nres))
19287 allocate(ees0p(maxconts,nres))
19288 allocate(ees0m(maxconts,nres))
19289 allocate(d_cont(maxconts,nres))
19290 allocate(ees0plist(maxconts,nres))
19293 allocate(num_cont_hb(nres))
19295 allocate(jcont_hb(maxconts,nres))
19298 allocate(Ug(2,2,nres))
19299 allocate(Ugder(2,2,nres))
19300 allocate(Ug2(2,2,nres))
19301 allocate(Ug2der(2,2,nres))
19303 allocate(obrot(2,nres))
19304 allocate(obrot2(2,nres))
19305 allocate(obrot_der(2,nres))
19306 allocate(obrot2_der(2,nres))
19308 ! common /precomp1/
19309 allocate(mu(2,nres))
19310 allocate(muder(2,nres))
19311 allocate(Ub2(2,nres))
19314 allocate(Ub2der(2,nres))
19315 allocate(Ctobr(2,nres))
19316 allocate(Ctobrder(2,nres))
19317 allocate(Dtobr2(2,nres))
19318 allocate(Dtobr2der(2,nres))
19320 allocate(EUg(2,2,nres))
19321 allocate(EUgder(2,2,nres))
19322 allocate(CUg(2,2,nres))
19323 allocate(CUgder(2,2,nres))
19324 allocate(DUg(2,2,nres))
19325 allocate(Dugder(2,2,nres))
19326 allocate(DtUg2(2,2,nres))
19327 allocate(DtUg2der(2,2,nres))
19329 ! common /precomp2/
19330 allocate(Ug2Db1t(2,nres))
19331 allocate(Ug2Db1tder(2,nres))
19332 allocate(CUgb2(2,nres))
19333 allocate(CUgb2der(2,nres))
19335 allocate(EUgC(2,2,nres))
19336 allocate(EUgCder(2,2,nres))
19337 allocate(EUgD(2,2,nres))
19338 allocate(EUgDder(2,2,nres))
19339 allocate(DtUg2EUg(2,2,nres))
19340 allocate(Ug2DtEUg(2,2,nres))
19342 allocate(Ug2DtEUgder(2,2,2,nres))
19343 allocate(DtUg2EUgder(2,2,2,nres))
19345 ! common /rotat_old/
19346 allocate(costab(nres))
19347 allocate(sintab(nres))
19348 allocate(costab2(nres))
19349 allocate(sintab2(nres))
19352 allocate(a_chuj(2,2,maxconts,nres))
19353 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19354 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19355 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19356 ! common /contdistrib/
19357 allocate(ncont_sent(nres))
19358 allocate(ncont_recv(nres))
19360 allocate(iat_sent(nres))
19362 allocate(iint_sent(4,nres,nres))
19363 allocate(iint_sent_local(4,nres,nres))
19365 allocate(iturn3_sent(4,0:nres+4))
19366 allocate(iturn4_sent(4,0:nres+4))
19367 allocate(iturn3_sent_local(4,nres))
19368 allocate(iturn4_sent_local(4,nres))
19370 allocate(itask_cont_from(0:nfgtasks-1))
19371 allocate(itask_cont_to(0:nfgtasks-1))
19372 !(0:max_fg_procs-1)
19376 !----------------------
19379 allocate(dcdv(6,maxdim))
19380 allocate(dxdv(6,maxdim))
19382 allocate(dxds(6,nres))
19384 allocate(gradx(3,-1:nres,0:2))
19385 allocate(gradc(3,-1:nres,0:2))
19387 allocate(gvdwx(3,-1:nres))
19388 allocate(gvdwc(3,-1:nres))
19389 allocate(gelc(3,-1:nres))
19390 allocate(gelc_long(3,-1:nres))
19391 allocate(gvdwpp(3,-1:nres))
19392 allocate(gvdwc_scpp(3,-1:nres))
19393 allocate(gradx_scp(3,-1:nres))
19394 allocate(gvdwc_scp(3,-1:nres))
19395 allocate(ghpbx(3,-1:nres))
19396 allocate(ghpbc(3,-1:nres))
19397 allocate(gradcorr(3,-1:nres))
19398 allocate(gradcorr_long(3,-1:nres))
19399 allocate(gradcorr5_long(3,-1:nres))
19400 allocate(gradcorr6_long(3,-1:nres))
19401 allocate(gcorr6_turn_long(3,-1:nres))
19402 allocate(gradxorr(3,-1:nres))
19403 allocate(gradcorr5(3,-1:nres))
19404 allocate(gradcorr6(3,-1:nres))
19405 allocate(gliptran(3,-1:nres))
19406 allocate(gliptranc(3,-1:nres))
19407 allocate(gliptranx(3,-1:nres))
19408 allocate(gshieldx(3,-1:nres))
19409 allocate(gshieldc(3,-1:nres))
19410 allocate(gshieldc_loc(3,-1:nres))
19411 allocate(gshieldx_ec(3,-1:nres))
19412 allocate(gshieldc_ec(3,-1:nres))
19413 allocate(gshieldc_loc_ec(3,-1:nres))
19414 allocate(gshieldx_t3(3,-1:nres))
19415 allocate(gshieldc_t3(3,-1:nres))
19416 allocate(gshieldc_loc_t3(3,-1:nres))
19417 allocate(gshieldx_t4(3,-1:nres))
19418 allocate(gshieldc_t4(3,-1:nres))
19419 allocate(gshieldc_loc_t4(3,-1:nres))
19420 allocate(gshieldx_ll(3,-1:nres))
19421 allocate(gshieldc_ll(3,-1:nres))
19422 allocate(gshieldc_loc_ll(3,-1:nres))
19423 allocate(grad_shield(3,-1:nres))
19424 allocate(gg_tube_sc(3,-1:nres))
19425 allocate(gg_tube(3,-1:nres))
19426 allocate(gradafm(3,-1:nres))
19428 allocate(grad_shield_side(3,50,nres))
19429 allocate(grad_shield_loc(3,50,nres))
19430 ! grad for shielding surroing
19431 allocate(gloc(0:maxvar,0:2))
19432 allocate(gloc_x(0:maxvar,2))
19434 allocate(gel_loc(3,-1:nres))
19435 allocate(gel_loc_long(3,-1:nres))
19436 allocate(gcorr3_turn(3,-1:nres))
19437 allocate(gcorr4_turn(3,-1:nres))
19438 allocate(gcorr6_turn(3,-1:nres))
19439 allocate(gradb(3,-1:nres))
19440 allocate(gradbx(3,-1:nres))
19442 allocate(gel_loc_loc(maxvar))
19443 allocate(gel_loc_turn3(maxvar))
19444 allocate(gel_loc_turn4(maxvar))
19445 allocate(gel_loc_turn6(maxvar))
19446 allocate(gcorr_loc(maxvar))
19447 allocate(g_corr5_loc(maxvar))
19448 allocate(g_corr6_loc(maxvar))
19450 allocate(gsccorc(3,-1:nres))
19451 allocate(gsccorx(3,-1:nres))
19453 allocate(gsccor_loc(-1:nres))
19455 allocate(dtheta(3,2,-1:nres))
19457 allocate(gscloc(3,-1:nres))
19458 allocate(gsclocx(3,-1:nres))
19460 allocate(dphi(3,3,-1:nres))
19461 allocate(dalpha(3,3,-1:nres))
19462 allocate(domega(3,3,-1:nres))
19464 ! common /deriv_scloc/
19465 allocate(dXX_C1tab(3,nres))
19466 allocate(dYY_C1tab(3,nres))
19467 allocate(dZZ_C1tab(3,nres))
19468 allocate(dXX_Ctab(3,nres))
19469 allocate(dYY_Ctab(3,nres))
19470 allocate(dZZ_Ctab(3,nres))
19471 allocate(dXX_XYZtab(3,nres))
19472 allocate(dYY_XYZtab(3,nres))
19473 allocate(dZZ_XYZtab(3,nres))
19476 allocate(jgrad_start(nres))
19477 allocate(jgrad_end(nres))
19479 !----------------------
19482 allocate(ibond_displ(0:nfgtasks-1))
19483 allocate(ibond_count(0:nfgtasks-1))
19484 allocate(ithet_displ(0:nfgtasks-1))
19485 allocate(ithet_count(0:nfgtasks-1))
19486 allocate(iphi_displ(0:nfgtasks-1))
19487 allocate(iphi_count(0:nfgtasks-1))
19488 allocate(iphi1_displ(0:nfgtasks-1))
19489 allocate(iphi1_count(0:nfgtasks-1))
19490 allocate(ivec_displ(0:nfgtasks-1))
19491 allocate(ivec_count(0:nfgtasks-1))
19492 allocate(iset_displ(0:nfgtasks-1))
19493 allocate(iset_count(0:nfgtasks-1))
19494 allocate(iint_count(0:nfgtasks-1))
19495 allocate(iint_displ(0:nfgtasks-1))
19496 !(0:max_fg_procs-1)
19497 !----------------------
19500 allocate(gcart(3,-1:nres))
19501 allocate(gxcart(3,-1:nres))
19503 allocate(gradcag(3,-1:nres))
19504 allocate(gradxag(3,-1:nres))
19506 ! common /back_constr/
19507 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19508 allocate(dutheta(nres))
19509 allocate(dugamma(nres))
19511 allocate(duscdiff(3,nres))
19512 allocate(duscdiffx(3,nres))
19514 !el i io:read_fragments
19515 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19516 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19518 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19519 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19520 allocate(mset(0:nprocs)) !(maxprocs/20)
19522 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19523 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19524 allocate(dUdconst(3,0:nres))
19525 allocate(dUdxconst(3,0:nres))
19526 allocate(dqwol(3,0:nres))
19527 allocate(dxqwol(3,0:nres))
19529 !----------------------
19531 ! common /sbridge/ in io_common: read_bridge
19532 !el allocate((:),allocatable :: iss !(maxss)
19533 ! common /links/ in io_common: read_bridge
19534 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19535 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19536 ! common /dyn_ssbond/
19537 ! and side-chain vectors in theta or phi.
19538 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19542 dyn_ssbond_ij(:,:)=1.0d300
19546 ! if (nss.gt.0) then
19547 allocate(idssb(maxdim),jdssb(maxdim))
19548 ! allocate(newihpb(nss),newjhpb(nss))
19551 allocate(ishield_list(nres))
19552 allocate(shield_list(50,nres))
19553 allocate(dyn_ss_mask(nres))
19554 allocate(fac_shield(nres))
19556 dyn_ss_mask(:)=.false.
19557 !----------------------
19559 ! Parameters of the SCCOR term
19561 !el in io_conf: parmread
19562 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19563 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19564 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19565 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19566 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19567 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19568 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19569 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19570 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19572 allocate(gloc_sc(3,0:2*nres,0:10))
19573 !(3,0:maxres2,10)maxres2=2*maxres
19574 allocate(dcostau(3,3,3,2*nres))
19575 allocate(dsintau(3,3,3,2*nres))
19576 allocate(dtauangle(3,3,3,2*nres))
19577 allocate(dcosomicron(3,3,3,2*nres))
19578 allocate(domicron(3,3,3,2*nres))
19579 !(3,3,3,maxres2)maxres2=2*maxres
19580 !----------------------
19583 allocate(varall(maxvar))
19584 !(maxvar)(maxvar=6*maxres)
19585 allocate(mask_theta(nres))
19586 allocate(mask_phi(nres))
19587 allocate(mask_side(nres))
19589 !----------------------
19592 allocate(uy(3,nres))
19593 allocate(uz(3,nres))
19595 allocate(uygrad(3,3,2,nres))
19596 allocate(uzgrad(3,3,2,nres))
19600 end subroutine alloc_ener_arrays
19601 !-----------------------------------------------------------------------------
19602 !-----------------------------------------------------------------------------