X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;ds=sidebyside;f=source%2Funres%2Fio_config.f90;h=aedb3dd88a5ec1ef119051fa6edd17937ec9e2f0;hb=05fce52032feb59f7e96cd897fb82ca2aa90a888;hp=393bfa4830db3a6280322e20ae26c0ea702eff1e;hpb=4240fc4a730e3ccb188915a928248273e25333d1;p=unres4.git diff --git a/source/unres/io_config.f90 b/source/unres/io_config.f90 index 393bfa4..aedb3dd 100644 --- a/source/unres/io_config.f90 +++ b/source/unres/io_config.f90 @@ -832,26 +832,15 @@ allocate(bthet(2,-ntyp:ntyp,-1:1,-1:1)) !(2,-ntyp:ntyp,-1:1,-1:1) allocate(polthet(0:3,-ntyp:ntyp)) !(0:3,-ntyp:ntyp) allocate(gthet(3,-ntyp:ntyp)) !(3,-ntyp:ntyp) - do i=-ntyp,ntyp - a0thet(i)=0.0D0 - do j=1,2 - do ichir1=-1,1 - do ichir2=-1,1 - athet(j,i,ichir1,ichir2)=0.0D0 - bthet(j,i,ichir1,ichir2)=0.0D0 - enddo - enddo - enddo - do j=0,3 - polthet(j,i)=0.0D0 - enddo - do j=1,3 - gthet(j,i)=0.0D0 - enddo - theta0(i)=0.0D0 - sig0(i)=0.0D0 - sigc0(i)=0.0D0 - enddo + + a0thet(:)=0.0D0 + athet(:,:,:,:)=0.0D0 + bthet(:,:,:,:)=0.0D0 + polthet(:,:)=0.0D0 + gthet(:,:)=0.0D0 + theta0(:)=0.0D0 + sig0(:)=0.0D0 + sigc0(:)=0.0D0 #ifdef CRYST_THETA ! @@ -998,34 +987,16 @@ do i=-ntyp1,-1 ithetyp(i)=-ithetyp(-i) enddo - do iblock=1,2 - do i=-maxthetyp,maxthetyp - do j=-maxthetyp,maxthetyp - do k=-maxthetyp,maxthetyp - aa0thet(i,j,k,iblock)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k,iblock)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k,iblock)=0.0d0 - ccthet(m,l,i,j,k,iblock)=0.0d0 - ddthet(m,l,i,j,k,iblock)=0.0d0 - eethet(m,l,i,j,k,iblock)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k,iblock)=0.0d0 - ggthet(mm,m,l,i,j,k,iblock)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - enddo + + aa0thet(:,:,:,:)=0.0d0 + aathet(:,:,:,:,:)=0.0d0 + bbthet(:,:,:,:,:,:)=0.0d0 + ccthet(:,:,:,:,:,:)=0.0d0 + ddthet(:,:,:,:,:,:)=0.0d0 + eethet(:,:,:,:,:,:)=0.0d0 + ffthet(:,:,:,:,:,:,:)=0.0d0 + ggthet(:,:,:,:,:,:,:)=0.0d0 + ! VAR:iblock means terminally blocking group 1=non-proline 2=proline do iblock=1,2 ! VAR:ntethtyp is type of theta potentials type currently 0=glycine @@ -1230,28 +1201,13 @@ allocate(censc(3,maxlob,-ntyp:ntyp)) !(3,maxlob,-ntyp:ntyp) allocate(gaussc(3,3,maxlob,-ntyp:ntyp)) !(3,3,maxlob,-ntyp:ntyp) - do i=1,ntyp - do j=1,maxlob - bsc(j,i)=0.0D0 - nlob(i)=0 - enddo - enddo - nlob(ntyp1)=0 - dsc(ntyp1)=0.0D0 - - do i=-ntyp,ntyp - do j=1,maxlob - do k=1,3 - censc(k,j,i)=0.0D0 - enddo - do k=1,3 - do l=1,3 - gaussc(l,k,j,i)=0.0D0 - enddo - enddo - enddo - enddo - + bsc(:,:)=0.0D0 + nlob(:)=0 + nlob(:)=0 + dsc(:)=0.0D0 + censc(:,:,:)=0.0D0 + gaussc(:,:,:,:)=0.0D0 + #ifdef CRYST_SC ! ! Read the parameters of the probability distribution/energy expression @@ -1454,14 +1410,8 @@ allocate(v1(maxterm,-ntortyp:ntortyp,-ntortyp:ntortyp,2)) allocate(v2(maxterm,-ntortyp:ntortyp,-ntortyp:ntortyp,2)) !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) !el--------------------------- - do iblock=1,2 - do i=-ntortyp,ntortyp - do j=-ntortyp,ntortyp - nterm(i,j,iblock)=0 - nlor(i,j,iblock)=0 - enddo - enddo - enddo + nterm(:,:,:)=0 + nlor(:,:,:)=0 !el--------------------------- read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) @@ -1966,16 +1916,14 @@ allocate(eps_scp(ntyp,2),rscp(ntyp,2)) !(ntyp,2) allocate(sigma0(ntyp),rr0(ntyp),sigii(ntyp)) !(ntyp) allocate(chip(ntyp1),alp(ntyp1)) !(ntyp) - do i=1,ntyp - do j=1,ntyp - augm(i,j)=0.0D0 - enddo - chip(i)=0.0D0 - alp(i)=0.0D0 - sigma0(i)=0.0D0 - sigii(i)=0.0D0 - rr0(i)=0.0D0 - enddo + + augm(:,:)=0.0D0 + chip(:)=0.0D0 + alp(:)=0.0D0 + sigma0(:)=0.0D0 + sigii(:)=0.0D0 + rr0(:)=0.0D0 + !-------------------------------- read (isidep,*,end=117,err=117) ipot,expon @@ -2077,15 +2025,12 @@ !el from module energy - COMMON.INTERACT------- allocate(aa(ntyp1,ntyp1),bb(ntyp1,ntyp1),chi(ntyp1,ntyp1)) !(ntyp,ntyp) allocate(sigma(0:ntyp1,0:ntyp1),r0(ntyp1,ntyp1)) !(0:ntyp1,0:ntyp1) - do i=1,ntyp1 - do j=1,ntyp1 - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 - chi(i,j)=0.0D0 - sigma(i,j)=0.0D0 - r0(i,j)=0.0D0 - enddo - enddo + aa(:,:)=0.0D0 + bb(:,:)=0.0D0 + chi(:,:)=0.0D0 + sigma(:,:)=0.0D0 + r0(:,:)=0.0D0 + !-------------------------------- do i=2,ntyp @@ -2162,11 +2107,7 @@ enddo allocate(aad(ntyp,2),bad(ntyp,2)) !(ntyp,2) - do i=1,ntyp - do j=1,2 - bad(i,j)=0.0D0 - enddo - enddo + bad(:,:)=0.0D0 #ifdef OLDSCP ! @@ -2655,34 +2596,9 @@ !!!el if(.not.allocated(theta)) then allocate(theta(nres+2)) -! allocate(phi(nres+2)) -! allocate(alph(nres+2)) -! allocate(omeg(nres+2)) - do i=1,nres+2 - theta(i)=0.0d0 -! phi(i)=0.0d0 -! alph(i)=0.0d0 -! omeg(i)=0.0d0 - enddo + theta(:)=0.0d0 endif -! allocate(costtab(nres)) -! allocate(sinttab(nres)) -! allocate(cost2tab(nres)) -! allocate(sint2tab(nres)) -! allocate(xxref(nres)) -! allocate(yyref(nres)) -! allocate(zzref(nres)) !(maxres) -! do i=1,nres -! costtab(i)=0.0d0 -! sinttab(i)=0.0d0 -! cost2tab(i)=0.0d0 -! sint2tab(i)=0.0d0 -! xxref(i)=0.0d0 -! yyref(i)=0.0d0 -! zzref(i)=0.0d0 -! enddo - -! endif + if(.not.allocated(phi)) allocate(phi(nres+2)) if(.not.allocated(alph)) allocate(alph(nres+2)) if(.not.allocated(omeg)) allocate(omeg(nres+2)) @@ -2698,17 +2614,11 @@ if(.not.allocated(dc_norm)) then ! if(.not.allocated(dc_norm)) allocate(dc_norm(3,0:2*nres+2)) allocate(dc_norm(3,0:2*nres+2)) - do i=0,2*nres+2 - dc_norm(1,i)=0.d0 - dc_norm(2,i)=0.d0 - dc_norm(3,i)=0.d0 - enddo + dc_norm(:,:)=0.d0 endif call int_from_cart(.true.,.false.) - call sc_loc_geom(.true.) -! call sc_loc_geom(.false.) -! wczesbiej bylo false + call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i)