X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fdata%2Fenergy_data.f90;h=5f340cfacd72a85d29db6dccabb7b68616d1a1ed;hb=540f877fc0c1eaf1389f53eef08fe02d352e25a2;hp=fc38d5aac4ded656267065df5d4085bbb03212cc;hpb=4367d241fbb2bc284580092d2d177b7c79ac3a42;p=unres4.git diff --git a/source/unres/data/energy_data.f90 b/source/unres/data/energy_data.f90 index fc38d5a..5f340cf 100644 --- a/source/unres/data/energy_data.f90 +++ b/source/unres/data/energy_data.f90 @@ -3,7 +3,7 @@ use names !----------------------------------------------------------------------------- ! Max. number of energy intervals - integer,parameter :: max_ene=21 !10 + integer,parameter :: max_ene=49 !10 !----------------------------------------------------------------------------- ! Maximum number of terms in SC bond-stretching potential integer,parameter :: maxbondterm=3 @@ -14,6 +14,7 @@ !----------------------------------------------------------------------------- ! Max. number of contacts per residue integer :: maxconts + integer,parameter :: maxcontsshi=50 !----------------------------------------------------------------------------- ! Max. number of SC contacts integer :: maxcont @@ -64,13 +65,16 @@ integer :: rescale_mode real(kind=8) :: wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang,& wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,& - wturn6,wvdwpp,wliptran,wshield,lipscale,wtube + wturn6,wvdwpp,wliptran,wshield,lipscale,wtube, & + wbond_nucl,wang_nucl,wcorr_nucl,wcorr3_nucl,welpp,wtor_nucl,& + wtor_d_nucl,welsb,wsbloc,wvdwsb,welpsb,wvdwpp_nucl,wvdwpsb,wcatprot,& + wcatcat,wscbase,wpepbase,wscpho,wpeppho #ifdef CLUSTER real(kind=8) :: scalscp #endif real(kind=8),dimension(:),allocatable :: weights !(n_ene) real(kind=8) :: temp0,scal14,cutoff_corr,delt_corr,r0_corr - integer :: ipot + integer :: ipot,ipot_nucl ! common /potentials/ character(len=3),dimension(5) :: potname = & (/'LJ ','LJK','BP ','GB ','GBV'/) @@ -91,19 +95,35 @@ real(kind=8),dimension(:,:),allocatable :: aa_aq,bb_aq,augm,aa_lip,bb_lip !(ntyp,ntyp) real(kind=8),dimension(:),allocatable :: sc_aa_tube_par,sc_bb_tube_par,& acavtub,bcavtub,ccavtub,dcavtub,tubetranene + real(kind=8),dimension(:,:),allocatable :: aa_nucl,bb_nucl real(kind=8) :: acavtubpep,bcavtubpep,ccavtubpep,dcavtubpep, & tubetranenepep,pep_aa_tube,pep_bb_tube,tubeR0 real(kind=8),dimension(3) :: tubecenter real(kind=8),dimension(:,:),allocatable :: aad,bad !(ntyp,2) real(kind=8),dimension(2,2) :: app,bpp,ael6,ael3 + real(kind=8),dimension(:),allocatable :: aad_nucl,bad_nucl !(ntyp,2) + real(kind=8),dimension(2,2) :: app_nucl,bpp_nucl + real(kind=8),dimension(:,:),allocatable :: ael6_nucl,& + ael3_nucl,ael32_nucl,ael63_nucl integer :: expon,expon2, nnt,nct,itypro + integer,dimension(5) :: nnt_molec,nct_molec integer,dimension(:,:),allocatable :: istart,iend !(maxres,maxint_gr) integer,dimension(:),allocatable :: nint_gr,itel,& ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr !(maxres) + integer,dimension(:,:),allocatable :: istart_nucl,iend_nucl !(maxres,maxint_gr) + integer,dimension(:),allocatable :: nint_gr_nucl,itel_nucl,& + ielstart_nucl,ielend_nucl,ielstart_vdw_nucl,ielend_vdw_nucl,nscp_gr_nucl !(maxres) + integer,dimension(:,:),allocatable :: iscpstart_nucl,iscpend_nucl !(maxres,maxint_gr) + + integer,dimension(:),allocatable :: istype,molnum integer,dimension(:,:),allocatable :: itype ! now itype has more molecule types integer,dimension(:,:),allocatable :: iscpstart,iscpend !(maxres,maxint_gr) integer :: iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,& iatel_e_vdw,iatscp_s,iatscp_e,ispp,iscp + integer :: iatsc_s_nucl,iatsc_e_nucl,iatel_s_nucl,iatel_e_nucl,& + iatel_s_vdw_nucl,iatel_e_vdw_nucl,iatscp_s_nucl,iatscp_e_nucl,& + ispp_nucl,iscp_nucl + ! 12/1/95 Array EPS included in the COMMON block. ! common /body/ real(kind=8),dimension(:,:),allocatable :: sigma !(0:ntyp1,0:ntyp1) @@ -112,12 +132,30 @@ real(kind=8),dimension(:),allocatable :: chip,alp,sigma0,& sigii,rr0 !(ntyp) real(kind=8),dimension(2,2) :: rpp,epp,elpp6,elpp3 + real(kind=8),dimension(:,:),allocatable :: sigma_nucl !(0:ntyp1,0:ntyp1) + real(kind=8),dimension(:,:),allocatable :: eps_nucl,sigmaii_nucl,& + chi_nucl,r0_nucl, chip_nucl !(ntyp,ntyp) r0e !!! nie używane + real(kind=8),dimension(:),allocatable :: alp_nucl,sigma0_nucl,& + sigii_nucl,rr0_nucl !(ntyp) + real(kind=8),dimension(2,2) :: rpp_nucl,epp_nucl + real(kind=8),dimension(:,:),allocatable ::elpp6_nucl,& + elpp3_nucl,elpp32_nucl,elpp63_nucl + real(kind=8):: r0pp,epspp,AEES,BEES + real(kind=8),dimension(:,:),allocatable :: r0d,eps_scp,rscp !(ntyp,2) r0d !!! nie używane + real(kind=8),dimension(:),allocatable :: eps_scp_nucl,rscp_nucl!(ntyp,2) r0d !!! nie używane + ! 12/5/03 modified 09/18/03 Bond stretching parameters. ! common /stretch/ real(kind=8) :: vbldp0,akp,distchainmax,vbldpDUM real(kind=8),dimension(:,:),allocatable :: vbldsc0,aksc,abond0 !(maxbondterm,ntyp) + real(kind=8) :: vbldp0_nucl,akp_nucl + real(kind=8),dimension(:,:),allocatable :: vbldsc0_nucl,& + aksc_nucl,abond0_nucl !(maxbondterm,ntyp) + integer,dimension(:),allocatable :: nbondterm !(ntyp) + integer,dimension(:),allocatable :: nbondterm_nucl !(ntyp) + !----------------------------------------------------------------------------- ! common.local ! Parameters of ab initio-derived potential of virtual-bond-angle bending @@ -125,6 +163,7 @@ integer :: nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,& ndouble,nntheterm integer,dimension(:),allocatable :: ithetyp !(-ntyp1:ntyp1) + integer,dimension(:,:),allocatable :: nstate !(-ntyp1:ntyp1) real(kind=8),dimension(:,:,:,:),allocatable :: aa0thet !(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) real(kind=8),dimension(:,:,:,:,:),allocatable :: aathet @@ -132,6 +171,20 @@ ccthet,ddthet,eethet !(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) real(kind=8),dimension(:,:,:,:,:,:,:),allocatable :: ffthet,ggthet + +!-----------nucleic acid parameters-------------------------- + integer :: nthetyp_nucl,ntheterm_nucl,ntheterm2_nucl,& + ntheterm3_nucl,nsingle_nucl,& + ndouble_nucl,nntheterm_nucl + integer,dimension(:),allocatable :: ithetyp_nucl !(-ntyp1:ntyp1) + real(kind=8),dimension(:,:,:),allocatable :: aa0thet_nucl +!(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + real(kind=8),dimension(:,:,:,:),allocatable :: aathet_nucl + real(kind=8),dimension(:,:,:,:,:),allocatable :: bbthet_nucl,& + ccthet_nucl,ddthet_nucl,eethet_nucl +!(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) + real(kind=8),dimension(:,:,:,:,:,:),allocatable :: ffthet_nucl,ggthet_nucl + !(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2) ! Parameters of the virtual-bond-angle probability distribution ! common /thetas/ @@ -157,6 +210,10 @@ iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start,& iint_end,iphi1_start,iphi1_end,itau_start,itau_end,& ilip_start,ilip_end,itube_start,itube_end + integer :: ibond_nucl_start,ibond_nucl_end,iphi_nucl_start,& + iphi_nucl_end,iphid_nucl_start,iphid_nucl_end,& + ibondp_nucl_start,ibondp_nucl_end,ithet_nucl_start,ithet_nucl_end,& + loc_start_nucl,loc_end_nucl integer,dimension(:),allocatable :: ibond_displ,ibond_count,& ithet_displ,ithet_count,iphi_displ,iphi_count,iphi1_displ,& iphi1_count,ivec_displ,ivec_count,iset_displ,iset_count,& @@ -210,6 +267,8 @@ ! Parameters of the SC rotamers (local) term ! common/scrot/ real(kind=8),dimension(:,:),allocatable :: sc_parmin !(maxsccoef,ntyp) + real(kind=8),dimension(:,:),allocatable :: sc_parmin_nucl !(maxsccoef,ntyp) + !----------------------------------------------------------------------------- ! common.torcnstr ! common /torcnstr/ @@ -217,9 +276,9 @@ integer,dimension(:),allocatable :: idih_constr,idih_nconstr,itheta_constr !(maxdih_constr) integer :: idihconstr_start,idihconstr_end, & ithetaconstr_start,ithetaconstr_end - real(kind=8) :: ftors +! real(kind=8) :: ftors real(kind=8),dimension(:),allocatable :: drange,theta_constr0,theta_drange !(maxdih_constr) - real(kind=8),dimension(:),allocatable :: phi0 !(maxdih_constr) + real(kind=8),dimension(:),allocatable :: phi0,ftors !(maxdih_constr) real(kind=8),dimension(:),allocatable :: for_thet_constr !(maxdih_constr) !----------------------------------------------------------------------------- @@ -237,6 +296,15 @@ integer,dimension(:),allocatable :: itortyp !(-ntyp1:ntyp1) integer,dimension(:,:,:),allocatable :: nterm,nlor !(-maxtor:maxtor,-maxtor:maxtor,2) integer :: ntortyp,nterm_old +!------torsion nucleic + real(kind=8),dimension(:,:),allocatable :: v0_nucl !(-maxtor:maxtor,-maxtor:maxtor,2) + real(kind=8),dimension(:,:,:),allocatable :: v1_nucl,v2_nucl !(maxterm,-maxtor:maxtor,-maxtor:maxtor) + real(kind=8),dimension(:,:,:),allocatable :: vlor1_nucl !(maxlor,-maxtor:maxtor,-maxtor:maxtor) + real(kind=8),dimension(:,:,:),allocatable :: vlor2_nucl,vlor3_nucl !(maxlor,maxtor,maxtor) + integer,dimension(:),allocatable :: itortyp_nucl !(-ntyp1:ntyp1) + integer,dimension(:,:),allocatable :: nterm_nucl,nlor_nucl !(-maxtor:maxtor,-maxtor:maxtor,2) + integer :: ntortyp_nucl,nterm_old_nucl + ! 6/23/01 - constants for double torsionals ! common /torsiond/ real(kind=8),dimension(:,:,:,:,:,:),allocatable :: v1c,v1s @@ -255,6 +323,14 @@ integer :: nloctyp ! common/fourier/ z wham real(kind=8),dimension(:,:),allocatable :: b !(13,0:maxtor) +!---------------MOMO--------------------------------------------------- + integer,dimension(:),allocatable :: icharge + real(kind=8),dimension(:,:),allocatable :: alphapol,epshead,& + sig0head,sigiso1,sigiso2,rborn,sigmap1,sigmap2,chis,wquad,chipp,& + epsintab + real(kind=8),dimension(:,:,:),allocatable :: alphasur,alphiso,& + wqdip,wstate,dtail + real(kind=8),dimension(:,:,:,:),allocatable :: dhead !----------------------------------------------------------------------------- ! 24 Apr 2017 ! Varibles for cutoff on electorstatic @@ -271,8 +347,36 @@ ! AFM real(kind=8) :: distafminit,forceAFMconst,velAFMconst integer :: afmend,afmbeg + real(kind=8),dimension(:,:), allocatable :: catprm + + real(kind=8),dimension(:,:), allocatable :: eps_scbase, & + sigma_scbase, & + sigmap1_scbase,sigmap2_scbase, & + dhead_scbasei, dhead_scbasej, epshead_scbase,& + sig0head_scbase, rborn_scbasei,rborn_scbasej,alphapol_scbase,epsintab_scbase,& + aa_scbase,bb_scbase + real(kind=8),dimension(:,:,:), allocatable :: alphasur_scbase, & + wdipdip_scbase,wqdip_scbase,chi_scbase,chipp_scbase,chis_scbase + real(kind=8),dimension(:), allocatable :: eps_pepbase, & + sigma_pepbase, & + sigmap1_pepbase,sigmap2_pepbase,& + aa_pepbase,bb_pepbase + real(kind=8),dimension(:,:), allocatable :: alphasur_pepbase, & + wdipdip_pepbase,chi_pepbase,chipp_pepbase,chis_pepbase + real(kind=8),dimension(:), allocatable :: eps_scpho, & + sigma_scpho, & + sigmap1_scpho,sigmap2_scpho,& + aa_scpho,bb_scpho,wqq_scpho,epsintab_scpho,alphapol_scpho,& + rborn_scphoi,rborn_scphoj,dhead_scphoi,alphi_scpho + real(kind=8),dimension(:,:), allocatable :: alphasur_scpho, & + chi_scpho,chipp_scpho,chis_scpho, & + wqdip_scpho + real(kind=8) ,dimension(4) :: alphasur_peppho + real(kind=8) ,dimension(2) :: wqdip_peppho + real(kind=8) :: eps_peppho,sigma_peppho,sigmap1_peppho,sigmap2_peppho, & + aa_peppho,bb_peppho end module energy_data