From: Emilia Lubecka Date: Wed, 18 Apr 2018 10:16:26 +0000 (+0200) Subject: added preminim X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=commitdiff_plain;ds=sidebyside;h=dea14b447a653d684083a0776b8164d572e9d8f4;hp=-c;p=unres4.git added preminim --- dea14b447a653d684083a0776b8164d572e9d8f4 diff --git a/source/unres/MD.f90 b/source/unres/MD.f90 index 7aaac15..e34b384 100644 --- a/source/unres/MD.f90 +++ b/source/unres/MD.f90 @@ -2507,9 +2507,9 @@ write (iout,*) "vcm right after adjustment:" write (iout,*) (vcm(j),j=1,3) endif - if ((.not.rest).and.(indpdb.eq.0)) then - call chainbuild - if(iranconf.ne.0) then + if (.not.rest) then +! call chainbuild + if(iranconf.ne.0 .or.indpdb.gt.0.and..not.unres_pdb .or.preminim) then if (overlapsc) then print *, 'Calling OVERLAP_SC' call overlap_sc(fail) diff --git a/source/unres/data/MD_data.f90 b/source/unres/data/MD_data.f90 index d0fa7e6..3273cfc 100644 --- a/source/unres/data/MD_data.f90 +++ b/source/unres/data/MD_data.f90 @@ -104,4 +104,5 @@ ! COMMON /BANII/ D real(kind=8),DIMENSION(:),allocatable :: D_ban !(MAXRES6) maxres6=6*maxres !----------------------------------------------------------------------------- + logical preminim ! pre-minimizaation flag end module MD_data diff --git a/source/unres/data/geometry_data.f90 b/source/unres/data/geometry_data.f90 index 49357af..eb64d82 100644 --- a/source/unres/data/geometry_data.f90 +++ b/source/unres/data/geometry_data.f90 @@ -43,7 +43,7 @@ integer,parameter :: maxlob=5 !----------------------------------------------------------------------------- ! Max number of symetric chains - integer,parameter :: maxsym=50 + integer,parameter :: maxsym=80!50 integer,parameter :: maxperm=120 !----------------------------------------------------------------------------- ! common.var diff --git a/source/unres/io_config.f90 b/source/unres/io_config.f90 index ee1402f..b52f157 100644 --- a/source/unres/io_config.f90 +++ b/source/unres/io_config.f90 @@ -2899,7 +2899,7 @@ if(.not. allocated(istype)) allocate(istype(maxres)) do i=1,100000 read (ipdbin,'(a80)',end=10) card -! write (iout,'(a)') card + write (iout,'(a)') card if (card(:5).eq.'HELIX') then nhfrag=nhfrag+1 lsecondary=.true. @@ -3362,10 +3362,10 @@ if (lprn) then write (iout,'(/a)') & "Cartesian coordinates of the reference structure" - write (iout,'(a,3(3x,a5),5x,3(3x,a5))') & + write (iout,'(a,16x,3(3x,a5),5x,3(3x,a5))') & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" do ires=1,nres - write (iout,'(5(a3,1x),i3,3f8.3,5x,3f8.3)') & + write (iout,'(5(a3,1x),i5,3f8.3,5x,3f8.3)') & (restyp(itype(ires,j),j),j=1,5),ires,(c(j,ires),j=1,3),& (c(j,ires+nres),j=1,3) enddo @@ -3376,7 +3376,7 @@ write (iout,'(a)') & "Backbone and SC coordinates as read from the PDB" do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') & + write (iout,'(i5,i3,2x,a,3f8.3,5x,3f8.3)') & ires,itype(ires,1),restyp(itype(ires,1),1),(c(j,ires),j=1,3),& (c(j,nres+ires),j=1,3) enddo @@ -3443,10 +3443,10 @@ if (lprn) then write (iout,'(/a)') & "Cartesian coordinates of the reference structure after sorting" - write (iout,'(a,3(3x,a5),5x,3(3x,a5))') & + write (iout,'(a,16x,3(3x,a5),5x,3(3x,a5))') & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" do ires=1,nres - write (iout,'(5(a3,1x),i3,3f8.3,5x,3f8.3)') & + write (iout,'(5(a3,1x),i5,3f8.3,5x,3f8.3)') & (restyp(itype(ires,j),j),j=1,5),ires,(c(j,ires),j=1,3),& (c(j,ires+nres),j=1,3) enddo @@ -3534,7 +3534,7 @@ write (iout,*) "symetr", symetr do i=1,nres lll=lll+1 -!c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) +! write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) if (i.gt.1) then if ((itype(i-1,1).eq.ntyp1).and.(i.gt.2)) then chain_length=lll-1 @@ -3563,7 +3563,7 @@ ! write (iout,*) "spraw lancuchy",chain_length,symetr ! do i=1,4 ! do kkk=1,chain_length -! write (iout,*) itype(kkk),(chain_rep(j,kkk,i), j=1,3) +! write (iout,*) itype(kkk,1),(chain_rep(j,kkk,i), j=1,3) ! enddo ! enddo ! enddiagnostic @@ -3586,7 +3586,7 @@ cou=0 do kkk=1,symetr icha=tabperm(i,kkk) -! write (iout,*) i,icha + write (iout,*) i,icha do lll=1,chain_length cou=cou+1 if (cou.le.nres) then @@ -3594,7 +3594,7 @@ kupa=mod(lll,chain_length) iprzes=(kkk-1)*chain_length+lll if (kupa.eq.0) kupa=chain_length -! write (iout,*) "kupa", kupa + write (iout,*) "kupa", kupa cref(j,iprzes,i)=chain_rep(j,kupa,icha) cref(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha) enddo @@ -3613,11 +3613,11 @@ cref(3,i,kkk),cref(1,nres+i,kkk),& cref(2,nres+i,kkk),cref(3,nres+i,kkk) enddo - 100 format (//' alpha-carbon coordinates ',& + 100 format (//' alpha-carbon coordinates ',& ' centroid coordinates'/ & ' ', 6X,'X',11X,'Y',11X,'Z', & 10X,'X',11X,'Y',11X,'Z') - 110 format (a,'(',i3,')',6f12.5) + 110 format (a,'(',i5,')',6f12.5) enddo !c enddiag @@ -4066,6 +4066,10 @@ large = index(controlcard,"LARGE").gt.0 print_compon = index(controlcard,"PRINT_COMPON").gt.0 rattle = index(controlcard,"RATTLE").gt.0 + preminim=(index(controlcard,'PREMINIM').gt.0) + write (iout,*) "PREMINIM ",preminim + dccart=(index(controlcard,'CART').gt.0) + if (preminim) call read_minim ! if performing umbrella sampling, fragments constrained are read from the fragment file nset=0 if(usampl) then