From 3dbe5ceeea4b858bc25fa1469237e697c0bf293f Mon Sep 17 00:00:00 2001 From: Adam Kazimierz Sieradzan Date: Fri, 31 Aug 2012 04:40:36 -0400 Subject: [PATCH] Zmiana 21 na ntyp1 w unres SRC_MD oraz SRC_MD-M --- source/cluster/wham/src-M/energy_p_new.F | 64 ++++++++-------- source/cluster/wham/src-M/geomout.F | 10 +-- source/cluster/wham/src-M/readpdb.f | 10 +-- source/cluster/wham/src-M/readrtns.F | 8 +- source/unres/src_MD-M/MD.F | 50 ++++++------- source/unres/src_MD-M/MD_A-MTS.F | 30 ++++---- source/unres/src_MD-M/elecont.f | 4 +- source/unres/src_MD-M/energy_p_new-sep_barrier.F | 68 ++++++++--------- source/unres/src_MD-M/energy_p_new_barrier.F | 86 +++++++++++----------- source/unres/src_MD-M/geomout.F | 10 +-- source/unres/src_MD-M/int_to_cart.f | 2 +- source/unres/src_MD-M/intcartderiv.F | 10 +-- source/unres/src_MD-M/lagrangian_lesyng.F | 8 +- source/unres/src_MD-M/moments.f | 10 +-- source/unres/src_MD-M/readpdb.F | 18 ++--- source/unres/src_MD-M/readrtns_CSA.F | 16 ++-- source/unres/src_MD-M/sc_move.F | 2 +- source/unres/src_MD-M/stochfric.F | 12 +-- source/unres/src_MD-M/thread.F | 4 +- source/unres/src_MD/energy_p_new_barrier.F | 12 +-- source/unres/src_MD/int_to_cart.f | 20 ++--- source/unres/src_MD/intcartderiv.F | 10 +-- source/unres/src_MD/readpdb.F | 6 +- source/unres/src_MD/readrtns.F | 8 +- source/unres/src_MD/sc_move.F | 2 +- source/unres/src_MD/stochfric.F | 2 +- source/unres/src_MD/thread.F | 4 +- 27 files changed, 243 insertions(+), 243 deletions(-) diff --git a/source/cluster/wham/src-M/energy_p_new.F b/source/cluster/wham/src-M/energy_p_new.F index 030de74..44bdc8d 100644 --- a/source/cluster/wham/src-M/energy_p_new.F +++ b/source/cluster/wham/src-M/energy_p_new.F @@ -364,7 +364,7 @@ cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw_t=0.0d0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -379,7 +379,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -529,7 +529,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw_t=0.0d0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -540,7 +540,7 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -633,7 +633,7 @@ c endif ind=0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -649,7 +649,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) chi2=chi(itypj,itypi) @@ -762,7 +762,7 @@ c if (icall.gt.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -778,7 +778,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) @@ -901,7 +901,7 @@ c if (icall.gt.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -917,7 +917,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) r0ij=r0(itypi,itypj) @@ -1806,7 +1806,7 @@ cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e gcorr_loc(i)=0.0d0 enddo do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle if (itel(i).eq.0) goto 1215 dxi=dc(1,i) dyi=dc(2,i) @@ -1820,7 +1820,7 @@ cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle if (itel(j).eq.0) goto 1216 ind=ind+1 iteli=itel(i) @@ -2556,7 +2556,7 @@ C Cartesian derivatives & +0.5d0*(pizda(1,1)+pizda(2,2)) enddo endif - else if (j.eq.i+3 .and. itype(i+2).ne.21) then + else if (j.eq.i+3 .and. itype(i+2).ne.ntyp1) then CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Fourth-order contributions @@ -2757,7 +2757,7 @@ cd print '(a)','Enter ESCP' c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e, c & ' scal14',scal14 do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i), c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) @@ -2770,7 +2770,7 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) do j=iscpstart(i,iint),iscpend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi @@ -3029,7 +3029,7 @@ c estr=0.0d0 estr1=0.0d0 do i=nnt+1,nct - if (itype(i-1).eq.21 .or. itype(i).eq.21) then + if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) do j=1,3 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) @@ -3053,7 +3053,7 @@ c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included c do i=nnt,nct iti=iabs(itype(i)) - if (iti.ne.10 .and. iti.ne.21) then + if (iti.ne.10 .and. iti.ne.ntyp1) then nbi=nbondterm(iti) if (nbi.eq.1) then diff=vbld(i+nres)-vbldsc0(1,iti) @@ -3129,7 +3129,7 @@ c write (iout,*) "nres",nres c write (*,'(a,i2)') 'EBEND ICG=',icg c write (iout,*) ithet_start,ithet_end do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle + if (itype(i-1).eq.ntyp1) cycle C Zero the energy function and its derivative at 0 or pi. call splinthet(theta(i),0.5d0*delta,ss,ssd) it=itype(i-1) @@ -3145,7 +3145,7 @@ C Zero the energy function and its derivative at 0 or pi. ichir21=isign(1,itype(i)) ichir22=isign(1,itype(i)) endif - if (i.gt.3 .and. itype(i-2).ne.21) then + if (i.gt.3 .and. itype(i-2).ne.ntyp1) then #ifdef OSF phii=phi(i) icrc=0 @@ -3160,7 +3160,7 @@ C Zero the energy function and its derivative at 0 or pi. y(1)=0.0D0 y(2)=0.0D0 endif - if (i.lt.nres .and. itype(i).ne.21) then + if (i.lt.nres .and. itype(i).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) icrc=0 @@ -3375,7 +3375,7 @@ C etheta=0.0D0 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle + if (itype(i-1).eq.ntyp1) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -3386,7 +3386,7 @@ CC Ta zmina jest niewlasciwa coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3 .and. itype(i-2).ne.21) then + if (i.gt.3 .and. itype(i-2).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -3406,7 +3406,7 @@ CC Ta zmina jest niewlasciwa sinph1(k)=0.0d0 enddo endif - if (i.lt.nres .and. itype(i).ne.21) then + if (i.lt.nres .and. itype(i).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -3567,7 +3567,7 @@ C ALPHA and OMEGA. c write (iout,'(a)') 'ESC' do i=loc_start,loc_end it=itype(i) - if (it.eq.21) cycle + if (it.eq.ntyp1) cycle if (it.eq.10) goto 1 nlobit=nlob(iabs(it)) c print *,'i=',i,' it=',it,' nlobit=',nlobit @@ -3860,7 +3860,7 @@ C delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end - if (itype(i).eq.21) cycle + if (itype(i).eq.ntyp1) cycle costtab(i+1) =dcos(theta(i+1)) sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) @@ -4251,8 +4251,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1) cycle itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) @@ -4336,8 +4336,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1) cycle if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215 if (iabs(itype(i)).eq.20) then iblock=2 @@ -4435,8 +4435,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors_d=0.0D0 do i=iphi_start,iphi_end-1 - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0) & goto 1215 itori=itortyp(itype(i-2)) @@ -4518,7 +4518,7 @@ c lprn=.true. c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor esccor=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle esccor_ii=0.0D0 itori=itype(i-2) itori1=itype(i-1) diff --git a/source/cluster/wham/src-M/geomout.F b/source/cluster/wham/src-M/geomout.F index 5a61305..4ef656f 100644 --- a/source/cluster/wham/src-M/geomout.F +++ b/source/cluster/wham/src-M/geomout.F @@ -19,7 +19,7 @@ ires=0 do i=nnt,nct iti=itype(i) - if (iti.eq.21) then + if (iti.eq.ntyp1) then ichain=ichain+1 ires=0 write (ipdb,'(a)') 'TER' @@ -38,12 +38,12 @@ enddo write (ipdb,'(a)') 'TER' do i=nnt,nct-1 - if (itype(i).eq.21) cycle - if (itype(i).eq.10 .and. itype(i+1).ne.21) then + if (itype(i).eq.ntyp1) cycle + if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then write (ipdb,30) ica(i),ica(i+1) - else if (itype(i).ne.10 .and. itype(i+1).ne.21) then + else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then write (ipdb,30) ica(i),ica(i+1),ica(i)+1 - else if (itype(i).ne.10 .and. itype(i+1).eq.21) then + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then write (ipdb,30) ica(i),ica(i)+1 endif enddo diff --git a/source/cluster/wham/src-M/readpdb.f b/source/cluster/wham/src-M/readpdb.f index 62f3f2b..9b443b0 100644 --- a/source/cluster/wham/src-M/readpdb.f +++ b/source/cluster/wham/src-M/readpdb.f @@ -23,7 +23,7 @@ C geometry. else if (card(:3).eq.'TER') then C End current chain ires_old=ires+1 - itype(ires_old)=21 + itype(ires_old)=ntyp1 ibeg=2 c write (iout,*) "Chain ended",ires,ishift,ires_old call sccenter(ires,iii,sccor) @@ -44,7 +44,7 @@ c write (iout,'(a80)') card ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 - itype(1)=21 + itype(1)=ntyp1 endif c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift ibeg=0 @@ -81,7 +81,7 @@ C system nres=ires do i=2,nres-1 c write (iout,*) i,itype(i) - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then c write (iout,*) "dummy",i,itype(i) do j=1,3 c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2 @@ -96,7 +96,7 @@ C Calculate the CM of the last side chain. nstart_sup=1 if (itype(nres).ne.10) then nres=nres+1 - itype(nres)=21 + itype(nres)=ntyp1 do j=1,3 dcj=c(j,nres-2)-c(j,nres-3) c(j,nres)=c(j,nres-1)+dcj @@ -112,7 +112,7 @@ C Calculate the CM of the last side chain. c(j,nres+1)=c(j,1) c(j,2*nres)=c(j,nres) enddo - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then nsup=nsup-1 nstart_sup=2 do j=1,3 diff --git a/source/cluster/wham/src-M/readrtns.F b/source/cluster/wham/src-M/readrtns.F index 0140df4..1b4c911 100644 --- a/source/cluster/wham/src-M/readrtns.F +++ b/source/cluster/wham/src-M/readrtns.F @@ -207,9 +207,9 @@ C Convert sequence to numeric code do i=1,nres #ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then #else - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then #endif itel(i)=0 #ifdef PROCOR @@ -232,8 +232,8 @@ C Convert sequence to numeric code nnt=1 nct=nres print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 + if (itype(1).eq.ntyp1) nnt=2 + if (itype(nres).eq.ntyp1) nct=nct-1 if (nstart.lt.nnt) nstart=nnt if (nend.gt.nct .or. nend.eq.0) nend=nct write (iout,*) "nstart",nstart," nend",nend diff --git a/source/unres/src_MD-M/MD.F b/source/unres/src_MD-M/MD.F index 704947a..a28d660 100644 --- a/source/unres/src_MD-M/MD.F +++ b/source/unres/src_MD-M/MD.F @@ -189,7 +189,7 @@ c Variable time step algorithm. enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 v_work(ind)=d_t(j,i+nres) @@ -291,7 +291,7 @@ c------------------------------------------------ double precision difftol /1.0d-5/ nbond=nct-nnt do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) nbond=nbond+1 + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) nbond=nbond+1 enddo c if (lprn1) then @@ -313,7 +313,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind1=ind1+1 do j=1,3 Bmat(ind+j,ind1)=dC_norm(j,i+nres) @@ -390,7 +390,7 @@ c Td(i)=Td(i)+vbl*Tmat(i,ind) enddo do k=nnt,nct - if (itype(k).ne.10 .and. itype(i).ne.21) then + if (itype(k).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 Td(i)=Td(i)+vbldsc0(1,itype(k))*Tmat(i,ind) endif @@ -423,7 +423,7 @@ c enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 zapas(ind)=-gxcart(j,i)+stochforcvec(ind) @@ -494,7 +494,7 @@ c & i,(dC(j,i),j=1,3),xx enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 xx=vbld(i+nres)-vbldsc0(1,itype(i)) write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') @@ -522,7 +522,7 @@ c do iter=1,maxiter endif enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 blen2 = scalar(dc(1,i+nres),dc(1,i+nres)) ppvec(ind)=2*vbldsc0(1,itype(i))**2-blen2 @@ -565,7 +565,7 @@ c do iter=1,maxiter ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc(j,i+nres)=zapas(ind+j) dc_work(ind+j)=zapas(ind+j) @@ -609,7 +609,7 @@ c Building the chain from the newly calculated coordinates & i,(dC(j,i),j=1,3),xx enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 xx=vbld(i+nres)-vbldsc0(1,itype(i)) write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') @@ -1178,7 +1178,7 @@ c forces). enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1221,7 +1221,7 @@ c Applying velocity Verlet algorithm - step 1 to coordinates enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=d_a_old(j,inres)*d_time @@ -1258,7 +1258,7 @@ c Step 2 of the velocity Verlet algorithm: update velocities enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1360,7 +1360,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time @@ -1436,7 +1436,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) @@ -1482,7 +1482,7 @@ c Side chains do j=1,3 accel(j)=aux(j) enddo - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) enddo @@ -1527,7 +1527,7 @@ c write (iout,*) "back",i,j,epdriftij enddo endif c Side chains - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 epdriftij= & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) @@ -1574,7 +1574,7 @@ c write(iout,*) "fact", fact enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=fact*d_t(j,inres) @@ -1933,7 +1933,7 @@ c Transfer to the d_t vector do i=nnt,nct-1 do j=1,3 ind=ind+1 - if (itype(i).ne.21 .and. itype(i+1).ne.21) then + if (itype(i).ne.ntyp1 .and. itype(i+1).ne.ntyp1) then d_t(j,i)=d_t_work(ind) else d_t(j,i)=0.0d0 @@ -1941,7 +1941,7 @@ c Transfer to the d_t vector enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 d_t(j,i+nres)=d_t_work(ind) @@ -2174,7 +2174,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2222,7 +2222,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 dc(j,inres)=dc_work(ind+j) @@ -2283,7 +2283,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) @@ -2440,7 +2440,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2489,7 +2489,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 dc(j,inres)=dc_work(ind+j) @@ -2550,7 +2550,7 @@ c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) diff --git a/source/unres/src_MD-M/MD_A-MTS.F b/source/unres/src_MD-M/MD_A-MTS.F index d7537ad..023baa9 100644 --- a/source/unres/src_MD-M/MD_A-MTS.F +++ b/source/unres/src_MD-M/MD_A-MTS.F @@ -209,7 +209,7 @@ c Variable time step algorithm. enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 v_work(ind)=d_t(j,i+nres) @@ -955,7 +955,7 @@ c forces). enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1005,7 +1005,7 @@ c Applying velocity Verlet algorithm - step 1 to coordinates enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=d_a_old(j,inres)*d_time @@ -1049,7 +1049,7 @@ c Step 2 of the velocity Verlet algorithm: update velocities enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1148,7 +1148,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time @@ -1213,7 +1213,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) @@ -1278,7 +1278,7 @@ c accel(j)=aux(j) enddo endif do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) accel_old(j)=accel_old(j)+d_a_old(j,i+nres) @@ -1331,7 +1331,7 @@ c write (iout,*) "back",i,j,epdriftij enddo endif c Side chains - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 epdriftij= & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) @@ -1378,7 +1378,7 @@ c write(iout,*) "fact", fact enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=fact*d_t(j,inres) @@ -1825,7 +1825,7 @@ c Transfer to the d_t vector enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 d_t(j,i+nres)=d_t_work(ind) @@ -2054,7 +2054,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2163,7 +2163,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) @@ -2320,7 +2320,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2369,7 +2369,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 dc(j,inres)=dc_work(ind+j) @@ -2430,7 +2430,7 @@ c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) diff --git a/source/unres/src_MD-M/elecont.f b/source/unres/src_MD-M/elecont.f index 634e908..a962630 100644 --- a/source/unres/src_MD-M/elecont.f +++ b/source/unres/src_MD-M/elecont.f @@ -42,7 +42,7 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ ees=0.0 evdw=0.0 do 1 i=nnt,nct-2 - if (itype(i).eq.21 .or. itype(i+1).eq.21) goto 1 + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) goto 1 xi=c(1,i) yi=c(2,i) zi=c(3,i) @@ -53,7 +53,7 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ ymedi=yi+0.5*dyi zmedi=zi+0.5*dzi do 4 j=i+2,nct-1 - if (itype(j).eq.21 .or. itype(j+1).eq.21) goto 4 + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) goto 4 ind=ind+1 iteli=itel(i) itelj=itel(j) diff --git a/source/unres/src_MD-M/energy_p_new-sep_barrier.F b/source/unres/src_MD-M/energy_p_new-sep_barrier.F index 815ca5a..6592ace 100644 --- a/source/unres/src_MD-M/energy_p_new-sep_barrier.F +++ b/source/unres/src_MD-M/energy_p_new-sep_barrier.F @@ -37,7 +37,7 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -50,7 +50,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -123,7 +123,7 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -138,7 +138,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -209,7 +209,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -220,7 +220,7 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -292,7 +292,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -303,7 +303,7 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -384,7 +384,7 @@ c endif ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -401,7 +401,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) @@ -497,7 +497,7 @@ c endif ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -514,7 +514,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) @@ -607,7 +607,7 @@ c if (icall.eq.0) lprn=.false. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -626,7 +626,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, @@ -745,7 +745,7 @@ c if (icall.eq.0) lprn=.false. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -764,7 +764,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, @@ -882,7 +882,7 @@ c if (icall.eq.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -899,7 +899,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) @@ -1004,7 +1004,7 @@ c if (icall.eq.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1021,7 +1021,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) @@ -1262,8 +1262,8 @@ C C Loop over i,i+2 and i,i+3 pairs of the peptide groups C do i=iturn3_start,iturn3_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle + if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 + & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1279,9 +1279,9 @@ C num_cont_hb(i)=num_conti enddo do i=iturn4_start,iturn4_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+3).eq.21 - & .or. itype(i+4).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 + & .or. itype(i+3).eq.ntyp1 + & .or. itype(i+4).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1293,7 +1293,7 @@ C zmedi=c(3,i)+0.5d0*dzi num_conti=num_cont_hb(i) call eelecij_scale(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21) + if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & call eturn4(i,eello_turn4) num_cont_hb(i)=num_conti enddo ! i @@ -1301,7 +1301,7 @@ c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1314,7 +1314,7 @@ c c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle call eelecij_scale(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti @@ -2000,7 +2000,7 @@ c write (iout,*) "iatel_s_vdw",iatel_s_vdw, c & " iatel_e_vdw",iatel_e_vdw call flush(iout) do i=iatel_s_vdw,iatel_e_vdw - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2015,7 +2015,7 @@ c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), c & ' ielend',ielend_vdw(i) call flush(iout) do j=ielstart_vdw(i),ielend_vdw(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -2088,7 +2088,7 @@ C cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) @@ -2098,7 +2098,7 @@ cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do j=iscpstart(i,iint),iscpend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi @@ -2189,7 +2189,7 @@ C cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) @@ -2199,7 +2199,7 @@ cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do j=iscpstart(i,iint),iscpend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi diff --git a/source/unres/src_MD-M/energy_p_new_barrier.F b/source/unres/src_MD-M/energy_p_new_barrier.F index f2f6372..0ce1a7b 100644 --- a/source/unres/src_MD-M/energy_p_new_barrier.F +++ b/source/unres/src_MD-M/energy_p_new_barrier.F @@ -1026,7 +1026,7 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1041,7 +1041,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -1179,7 +1179,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1190,7 +1190,7 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -1272,7 +1272,7 @@ c endif ind=0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1289,7 +1289,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) @@ -1392,7 +1392,7 @@ c if (icall.eq.0) lprn=.false. ind=0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1411,7 +1411,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, @@ -1537,7 +1537,7 @@ c if (icall.eq.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1554,7 +1554,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) @@ -1785,7 +1785,7 @@ cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1798,7 +1798,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -1866,7 +1866,7 @@ cd write(iout,*) 'In EELEC_soft_sphere' eello_turn4=0.0d0 ind=0 do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1876,7 +1876,7 @@ cd write(iout,*) 'In EELEC_soft_sphere' num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -2755,8 +2755,8 @@ C C Loop over i,i+2 and i,i+3 pairs of the peptide groups C do i=iturn3_start,iturn3_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 + & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2772,9 +2772,9 @@ C num_cont_hb(i)=num_conti enddo do i=iturn4_start,iturn4_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+3).eq.21 - & .or. itype(i+4).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 + & .or. itype(i+3).eq.ntyp1 + & .or. itype(i+4).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2786,7 +2786,7 @@ C zmedi=c(3,i)+0.5d0*dzi num_conti=num_cont_hb(i) call eelecij(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21) + if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & call eturn4(i,eello_turn4) num_cont_hb(i)=num_conti enddo ! i @@ -2794,7 +2794,7 @@ c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2808,7 +2808,7 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) do j=ielstart(i),ielend(i) c write (iout,*) i,j,itype(i),itype(j) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle call eelecij(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti @@ -3802,7 +3802,7 @@ C cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) @@ -3811,7 +3811,7 @@ cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - if (itype(j).eq.21) cycle + if (itype(j).eq.ntyp1) cycle itypj=iabs(itype(j)) C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi @@ -3898,7 +3898,7 @@ C cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) @@ -3908,7 +3908,7 @@ cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do j=iscpstart(i,iint),iscpend(i,iint) itypj=iabs(itype(j)) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi @@ -4180,7 +4180,7 @@ c estr=0.0d0 estr1=0.0d0 do i=ibondp_start,ibondp_end - if (itype(i-1).eq.21 .or. itype(i).eq.21) then + if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) do j=1,3 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) @@ -4205,7 +4205,7 @@ c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included c do i=ibond_start,ibond_end iti=iabs(itype(i)) - if (iti.ne.10 .and. iti.ne.21) then + if (iti.ne.10 .and. iti.ne.ntyp1) then nbi=nbondterm(iti) if (nbi.eq.1) then diff=vbld(i+nres)-vbldsc0(1,iti) @@ -4278,7 +4278,7 @@ c time12=1.0d0 etheta=0.0D0 c write (*,'(a,i2)') 'EBEND ICG=',icg do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle + if (itype(i-1).eq.ntyp1) cycle C Zero the energy function and its derivative at 0 or pi. call splinthet(theta(i),0.5d0*delta,ss,ssd) it=itype(i-1) @@ -4295,7 +4295,7 @@ C Zero the energy function and its derivative at 0 or pi. ichir22=isign(1,itype(i)) endif - if (i.gt.3 .and. itype(i-2).ne.21) then + if (i.gt.3 .and. itype(i-2).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -4308,7 +4308,7 @@ C Zero the energy function and its derivative at 0 or pi. y(1)=0.0D0 y(2)=0.0D0 endif - if (i.lt.nres .and. itype(i).ne.21) then + if (i.lt.nres .and. itype(i).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -4516,7 +4516,7 @@ C logical lprn /.false./, lprn1 /.false./ etheta=0.0D0 do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle + if (itype(i-1).eq.ntyp1) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -4526,7 +4526,7 @@ C coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3 .and. itype(i-2).ne.21) then + if (i.gt.3 .and. itype(i-2).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -4546,7 +4546,7 @@ C sinph1(k)=0.0d0 enddo endif - if (i.lt.nres .and. itype(i).ne.21) then + if (i.lt.nres .and. itype(i).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -4704,7 +4704,7 @@ C ALPHA and OMEGA. c write (iout,'(a)') 'ESC' do i=loc_start,loc_end it=itype(i) - if (it.eq.21) cycle + if (it.eq.ntyp1) cycle if (it.eq.10) goto 1 nlobit=nlob(iabs(it)) c print *,'i=',i,' it=',it,' nlobit=',nlobit @@ -5003,7 +5003,7 @@ C delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end - if (itype(i).eq.21) cycle + if (itype(i).eq.ntyp1) cycle costtab(i+1) =dcos(theta(i+1)) sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) @@ -5431,8 +5431,8 @@ c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end etors_ii=0.0D0 - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1) cycle itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) @@ -5528,8 +5528,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1) cycle etors_ii=0.0D0 if (iabs(itype(i)).eq.20) then iblock=2 @@ -5629,8 +5629,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors_d=0.0D0 do i=iphid_start,iphid_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) itori2=itortyp(itype(i)) @@ -5709,7 +5709,7 @@ c lprn=.true. c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor esccor=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle esccor_ii=0.0D0 itori=iabs(itype(i-2)) itori1=iabs(itype(i-1)) diff --git a/source/unres/src_MD-M/geomout.F b/source/unres/src_MD-M/geomout.F index 47e8c7e..f12d33a 100644 --- a/source/unres/src_MD-M/geomout.F +++ b/source/unres/src_MD-M/geomout.F @@ -91,7 +91,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 ires=0 do i=nnt,nct iti=itype(i) - if (iti.eq.21) then + if (iti.eq.ntyp1) then ichain=ichain+1 ires=0 write (iunit,'(a)') 'TER' @@ -111,12 +111,12 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 enddo write (iunit,'(a)') 'TER' do i=nnt,nct-1 - if (itype(i).eq.21) cycle - if (itype(i).eq.10 .and. itype(i+1).ne.21) then + if (itype(i).eq.ntyp1) cycle + if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then write (iunit,30) ica(i),ica(i+1) - else if (itype(i).ne.10 .and. itype(i+1).ne.21) then + else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then write (iunit,30) ica(i),ica(i+1),ica(i)+1 - else if (itype(i).ne.10 .and. itype(i+1).eq.21) then + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then write (iunit,30) ica(i),ica(i)+1 endif enddo diff --git a/source/unres/src_MD-M/int_to_cart.f b/source/unres/src_MD-M/int_to_cart.f index 55997f4..9208a80 100644 --- a/source/unres/src_MD-M/int_to_cart.f +++ b/source/unres/src_MD-M/int_to_cart.f @@ -106,7 +106,7 @@ c Settind dE/ddnres-1 enddo c The side-chain vector derivatives do i=2,nres-1 - if(itype(i).ne.10 .and. itype(i).ne.21) then + if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i) diff --git a/source/unres/src_MD-M/intcartderiv.F b/source/unres/src_MD-M/intcartderiv.F index 61a423b..33d4a50 100644 --- a/source/unres/src_MD-M/intcartderiv.F +++ b/source/unres/src_MD-M/intcartderiv.F @@ -47,10 +47,10 @@ c We need dtheta(:,:,i-1) to compute dphi(:,:,i) do j=1,3 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ & vbld(i-1) - if (itype(i-1).ne.21) dtheta(j,1,i)=-dcostheta(j,1,i)/sint + if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/ & vbld(i) - if (itype(i-1).ne.21) dtheta(j,2,i)=-dcostheta(j,2,i)/sint + if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint enddo enddo @@ -88,7 +88,7 @@ c Obtaining the gamma derivatives from sine derivative ctgt=cost/sint ctgt1=cost1/sint1 cosg_inv=1.0d0/cosg - if (itype(i-1).ne.21 .and. itype(i-2).ne.21) then + if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) @@ -106,7 +106,7 @@ c Bug fixed 3/24/05 (AL) c Obtaining the gamma derivatives from cosine derivative else do j=1,3 - if (itype(i-1).ne.21 .and. itype(i-2).ne.21) then + if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* & dc_norm(j,i-3))/vbld(i-2) @@ -130,7 +130,7 @@ c Derivatives of side-chain angles alpha and omega #else do i=2,nres-1 #endif - if(itype(i).ne.10 .and. itype(i).ne.21) then + if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) fac6=fac5/vbld(i) fac7=fac5*fac5 diff --git a/source/unres/src_MD-M/lagrangian_lesyng.F b/source/unres/src_MD-M/lagrangian_lesyng.F index f9a48fc..9611f90 100644 --- a/source/unres/src_MD-M/lagrangian_lesyng.F +++ b/source/unres/src_MD-M/lagrangian_lesyng.F @@ -46,7 +46,7 @@ c------------------------------------------------------------------------- enddo if (lprn) write (iout,*) "Potential forces sidechain" do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') & i,(-gcart(j,i),j=1,3) do j=1,3 @@ -69,7 +69,7 @@ c------------------------------------------------------------------------- enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 d_a(j,i+nres)=d_a_work(ind) @@ -212,13 +212,13 @@ c Diagonal elements of the dX part of A and the respective friction coefficient m1=nct-nnt+1 ind=0 ind1=0 - msc(21)=1.0d0 + msc(ntyp1)=1.0d0 do i=nnt,nct ind=ind+1 ii = ind+m iti=itype(i) massvec(ii)=msc(iti) - if (iti.ne.10 .and. iti.ne.21) then + if (iti.ne.10 .and. iti.ne.ntyp1) then ind1=ind1+1 ii1= ind1+m1 A(ii,ii1)=1.0d0 diff --git a/source/unres/src_MD-M/moments.f b/source/unres/src_MD-M/moments.f index 50f4d8b..5992773 100644 --- a/source/unres/src_MD-M/moments.f +++ b/source/unres/src_MD-M/moments.f @@ -96,7 +96,7 @@ c calculating the center of the mass of the protein do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then iti=iabs(itype(i)) inres=i+nres Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)* @@ -179,7 +179,7 @@ c Resetting the velocities enddo enddo do i=nnt,nct - if(itype(i).ne.10 .and. itype(i).ne.21) then + if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres call vecpr(vrot(1),dc(1,inres),vp) do j=1,3 @@ -249,7 +249,7 @@ c Calculate the angular momentum do j=1,3 pr(j)=c(j,inres)-cm(j) enddo - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 v(j)=incr(j)+d_t(j,inres) enddo @@ -265,7 +265,7 @@ c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3) L(j)=L(j)+msc(iti)*vp(j) enddo c write (iout,*) "L",(l(j),j=1,3) - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 v(j)=incr(j)+d_t(j,inres) enddo @@ -307,7 +307,7 @@ c------------------------------------------------------------------------------ endif amas=msc(iabs(itype(i))) summas=summas+amas - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres)) enddo diff --git a/source/unres/src_MD-M/readpdb.F b/source/unres/src_MD-M/readpdb.F index 973ef16..db10d83 100644 --- a/source/unres/src_MD-M/readpdb.F +++ b/source/unres/src_MD-M/readpdb.F @@ -45,7 +45,7 @@ crc---------------------------------------- else if (card(:3).eq.'TER') then C End current chain ires_old=ires+1 - itype(ires_old)=21 + itype(ires_old)=ntyp1 ibeg=2 c write (iout,*) "Chain ended",ires,ishift,ires_old if (unres_pdb) then @@ -78,7 +78,7 @@ c write (iout,'(a80)') card ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 - itype(1)=21 + itype(1)=ntyp1 endif c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift ibeg=0 @@ -117,7 +117,7 @@ C system nres=ires do i=2,nres-1 c write (iout,*) i,itype(i) - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then c write (iout,*) "dummy",i,itype(i) do j=1,3 c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2 @@ -138,7 +138,7 @@ C Calculate the CM of the last side chain. nstart_sup=1 if (itype(nres).ne.10) then nres=nres+1 - itype(nres)=21 + itype(nres)=ntyp1 if (unres_pdb) then c(1,nres)=c(1,nres-1)+3.8d0 c(2,nres)=c(2,nres-1) @@ -160,7 +160,7 @@ C Calculate the CM of the last side chain. c(j,nres+1)=c(j,1) c(j,2*nres)=c(j,nres) enddo - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then nsup=nsup-1 nstart_sup=2 if (unres_pdb) then @@ -213,7 +213,7 @@ C Splits to single chain if occurs lll=lll+1 cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) if (i.gt.1) then - if ((itype(i-1).eq.21)) then + if ((itype(i-1).eq.ntyp1)) then chain_length=lll-1 kkk=kkk+1 c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) @@ -348,7 +348,7 @@ c--------------------------------------------------------------------------- #endif do i=1,nres-1 iti=itype(i) - if (iti.ne.21 .and. itype(i+1).ne.21 .and. + if (iti.ne.ntyp1 .and. itype(i+1).ne.ntyp1 .and. & (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0)) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i ctest stop @@ -431,7 +431,7 @@ c------------------------------------------------------------------------------- enddo enddo do i=2,nres-1 - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) enddo @@ -451,7 +451,7 @@ c------------------------------------------------------------------------------- sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) it=itype(i) - if (it.ne.10 .and. itype(i).ne.21) then + if (it.ne.10 .and. itype(i).ne.ntyp1) then c C Compute the axes of tghe local cartesian coordinates system; store in c x_prime, y_prime and z_prime diff --git a/source/unres/src_MD-M/readrtns_CSA.F b/source/unres/src_MD-M/readrtns_CSA.F index 75c418a..70bacea 100644 --- a/source/unres/src_MD-M/readrtns_CSA.F +++ b/source/unres/src_MD-M/readrtns_CSA.F @@ -717,7 +717,7 @@ c print *,'Finished reading pdb data' maxsi=1000 do i=2,nres-1 iti=itype(i) - if (iti.ne.10 .and. itype(i).ne.21) then + if (iti.ne.10 .and. itype(i).ne.ntyp1) then nsi=0 fail=.true. do while (fail.and.nsi.le.maxsi) @@ -759,9 +759,9 @@ c print *,nres c print '(20i4)',(itype(i),i=1,nres) do i=1,nres #ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then #else - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then #endif itel(i)=0 #ifdef PROCOR @@ -824,8 +824,8 @@ C 8/13/98 Set limits to generating the dihedral angles #endif nct=nres cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 + if (itype(1).eq.ntyp1) nnt=2 + if (itype(nres).eq.ntyp1) nct=nct-1 if (pdbref) then if(me.eq.king.or..not.out1file) & write (iout,'(a,i3)') 'nsup=',nsup @@ -942,7 +942,7 @@ C initial geometry. enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc(j,i+nres)=c(j,i+nres)-c(j,i) dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres) @@ -1212,7 +1212,7 @@ c enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc(j,i+nres)=c(j,i+nres)-c(j,i) dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) @@ -1292,7 +1292,7 @@ C Set up variable list. nvar=ntheta+nphi nside=0 do i=2,nres-1 - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then nside=nside+1 ialph(i,1)=nvar+nside ialph(nside,2)=i diff --git a/source/unres/src_MD-M/sc_move.F b/source/unres/src_MD-M/sc_move.F index 5287de8..2082e98 100644 --- a/source/unres/src_MD-M/sc_move.F +++ b/source/unres/src_MD-M/sc_move.F @@ -211,7 +211,7 @@ c Define what is meant by "neighbouring side-chain" c Don't do glycine or ends i=itype(res_pick) - if (i.eq.10 .or. i.eq.21) return + if (i.eq.10 .or. i.eq.ntyp1) return c Freeze everything (later will relax only selected side-chains) mask_r=.true. diff --git a/source/unres/src_MD-M/stochfric.F b/source/unres/src_MD-M/stochfric.F index 3ad7650..6427551 100644 --- a/source/unres/src_MD-M/stochfric.F +++ b/source/unres/src_MD-M/stochfric.F @@ -39,7 +39,7 @@ ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 d_t_work(ind+j)=d_t(j,i+nres) enddo @@ -68,7 +68,7 @@ ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 friction(j,i+nres)=fric_work(ind+j) enddo @@ -215,7 +215,7 @@ c Compute the stochastic forces acting on virtual-bond vectors. do j=1,3 ff(j)=ff(j)+force(j,i) enddo - if (itype(i+1).ne.21) then + if (itype(i+1).ne.ntyp1) then do j=1,3 stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1) ff(j)=ff(j)+force(j,i+nres+1) @@ -226,7 +226,7 @@ c Compute the stochastic forces acting on virtual-bond vectors. stochforc(j,0)=ff(j)+force(j,nnt+nres) enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 stochforc(j,i+nres)=force(j,i+nres) enddo @@ -244,7 +244,7 @@ c Compute the stochastic forces acting on virtual-bond vectors. ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 stochforcvec(ind+j)=stochforc(j,i+nres) enddo @@ -355,7 +355,7 @@ c Load the friction coefficients corresponding to peptide groups c Load the friction coefficients corresponding to side chains m=nct-nnt ind=0 - gamsc(21)=1.0d0 + gamsc(ntyp1)=1.0d0 do i=nnt,nct ind=ind+1 ii = ind+m diff --git a/source/unres/src_MD-M/thread.F b/source/unres/src_MD-M/thread.F index 9f169a0..f713744 100644 --- a/source/unres/src_MD-M/thread.F +++ b/source/unres/src_MD-M/thread.F @@ -146,14 +146,14 @@ cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr, cd non_conv) cd write (iout,'(a,f10.5)') cd & 'Initial RMS deviation from reference structure:',rms - if (itype(nres).eq.21) then + if (itype(nres).eq.ntyp1) then do j=1,3 dcj=c(j,nres-2)-c(j,nres-3) c(j,nres)=c(j,nres-1)+dcj c(j,2*nres)=c(j,nres) enddo endif - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then do j=1,3 dcj=c(j,4)-c(j,3) c(j,1)=c(j,2)-dcj diff --git a/source/unres/src_MD/energy_p_new_barrier.F b/source/unres/src_MD/energy_p_new_barrier.F index e0c61d8..cc43a72 100644 --- a/source/unres/src_MD/energy_p_new_barrier.F +++ b/source/unres/src_MD/energy_p_new_barrier.F @@ -5990,14 +5990,14 @@ c 2 = Ca...Ca...Ca...SC c 3 = SC...Ca...Ca...SCi gloci=0.0D0 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. - & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or. - & (itype(i-1).eq.21))) + & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-1).eq.ntyp1))) & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) - & .or.(itype(i-2).eq.21))) + & .or.(itype(i-2).eq.ntyp1))) & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. - & (itype(i-1).eq.21)))) cycle - if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle - if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21)) + & (itype(i-1).eq.ntyp1)))) cycle + if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle + if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) & cycle do j=1,nterm_sccor(isccori,isccori1) v1ij=v1sccor(j,intertyp,isccori,isccori1) diff --git a/source/unres/src_MD/int_to_cart.f b/source/unres/src_MD/int_to_cart.f index 73e8384..1051218 100644 --- a/source/unres/src_MD/int_to_cart.f +++ b/source/unres/src_MD/int_to_cart.f @@ -131,7 +131,7 @@ c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg) c enddo if (nres.lt.2) return if ((nres.lt.3).and.(itype(1).eq.10)) return - if ((itype(1).ne.10).and.(itype(1).ne.21)) then + if ((itype(1).ne.10).and.(itype(1).ne.ntyp1)) then do j=1,3 cc Derviative was calculated for oposite vector of side chain therefore c there is "-" sign before gloc_sc @@ -139,7 +139,7 @@ c there is "-" sign before gloc_sc & dtauangle(j,1,1,3) gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)* & dtauangle(j,1,2,3) - if ((itype(2).ne.10).and.(itype(2).ne.21)) then + if ((itype(2).ne.10).and.(itype(2).ne.ntyp1)) then gxcart(j,1)= gxcart(j,1) & -gloc_sc(3,0,icg)*dtauangle(j,3,1,3) gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)* @@ -147,7 +147,7 @@ c there is "-" sign before gloc_sc endif enddo endif - if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.21)) + if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.ntyp1)) & then do j=1,3 gcart(j,1)=gcart(j,1)+gloc_sc(2,1,icg)*dtauangle(j,2,1,4) @@ -159,10 +159,10 @@ c & +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3) c Calculating the remainder of dE/ddc2 do j=1,3 - if((itype(2).ne.10).and.(itype(2).ne.21)) then + if((itype(2).ne.10).and.(itype(2).ne.ntyp1)) then if (itype(1).ne.10) gxcart(j,2)=gxcart(j,2)+ & gloc_sc(3,0,icg)*dtauangle(j,3,3,3) - if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.21)) then + if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.ntyp1)) then gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4) cc the - above is due to different vector direction gcart(j,2)=gcart(j,2)+gloc_sc(3,1,icg)*dtauangle(j,3,2,4) @@ -175,7 +175,7 @@ c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart" c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx" endif endif - if ((itype(1).ne.10).and.(itype(1).ne.21)) then + if ((itype(1).ne.10).and.(itype(1).ne.ntyp1)) then gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3) c write(iout,*) gloc_sc(1,0,icg),dtauangle(j,1,3,3) endif @@ -235,7 +235,7 @@ c & dtauangle(j,2,2,i+2) c Setting dE/ddnres-1 if(nres.ge.4) then do j=1,3 - if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.21)) then + if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.ntyp1)) then gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg) & *dtauangle(j,2,3,nres) c write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg), @@ -244,18 +244,18 @@ c & dtauangle(j,2,3,nres), gxcart(j,nres-1) gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg) & *dtauangle(j,3,3,nres) endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then + if ((itype(nres).ne.10).and.(itype(nres).ne.ntyp1)) then gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg) & *dtauangle(j,3,1,nres+1) gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg) & *dtauangle(j,3,2,nres+1) endif endif - if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.21)) then + if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.ntyp1)) then gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)* & dtauangle(j,1,3,nres) endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then + if ((itype(nres).ne.10).and.(itype(nres).ne.ntyp1)) then gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)* & dtauangle(j,2,2,nres+1) c write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg), diff --git a/source/unres/src_MD/intcartderiv.F b/source/unres/src_MD/intcartderiv.F index c220540..5da4fc7 100644 --- a/source/unres/src_MD/intcartderiv.F +++ b/source/unres/src_MD/intcartderiv.F @@ -52,7 +52,7 @@ c We need dtheta(:,:,i-1) to compute dphi(:,:,i) #else do i=3,nres #endif - if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then + if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then cost1=dcos(omicron(1,i)) sint1=sqrt(1-cost1*cost1) cost2=dcos(omicron(2,i)) @@ -155,7 +155,7 @@ Calculate derivative of Tauangle #else do i=3,nres #endif - if ((itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle + if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle cc dtauangle(j,intertyp,dervityp,residue number) cc INTERTYP=1 SC...Ca...Ca..Ca c the conventional case @@ -230,7 +230,7 @@ CC Second case Ca...Ca...Ca...SC #else do i=4,nres #endif - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10)) cycle + if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10)) cycle c the conventional case sint=dsin(omicron(1,i)) sint1=dsin(theta(i-1)) @@ -305,8 +305,8 @@ CCC third case SC...Ca...Ca...SC do i=3,nres #endif c the conventional case - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10).or. - &(itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle + if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. + &(itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle sint=dsin(omicron(1,i)) sint1=dsin(omicron(2,i-1)) sing=dsin(tauangle(3,i)) diff --git a/source/unres/src_MD/readpdb.F b/source/unres/src_MD/readpdb.F index 563941b..1d8c3fb 100644 --- a/source/unres/src_MD/readpdb.F +++ b/source/unres/src_MD/readpdb.F @@ -62,7 +62,7 @@ C Start new residue. ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 - itype(1)=21 + itype(1)=ntyp1 endif ibeg=0 endif @@ -102,7 +102,7 @@ C Calculate the CM of the last side chain. nstart_sup=1 if (itype(nres).ne.10) then nres=nres+1 - itype(nres)=21 + itype(nres)=ntyp1 if (unres_pdb) then c(1,nres)=c(1,nres-1)+3.8d0 c(2,nres)=c(2,nres-1) @@ -124,7 +124,7 @@ C Calculate the CM of the last side chain. c(j,nres+1)=c(j,1) c(j,2*nres)=c(j,nres) enddo - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then nsup=nsup-1 nstart_sup=2 if (unres_pdb) then diff --git a/source/unres/src_MD/readrtns.F b/source/unres/src_MD/readrtns.F index 7050dab..25a4bc0 100644 --- a/source/unres/src_MD/readrtns.F +++ b/source/unres/src_MD/readrtns.F @@ -940,9 +940,9 @@ c print *,nres c print '(20i4)',(itype(i),i=1,nres) do i=1,nres #ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then #else - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then #endif itel(i)=0 #ifdef PROCOR @@ -1005,8 +1005,8 @@ C 8/13/98 Set limits to generating the dihedral angles #endif nct=nres cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 + if (itype(1).eq.ntyp1) nnt=2 + if (itype(nres).eq.ntyp1) nct=nct-1 if (pdbref) then if(me.eq.king.or..not.out1file) & write (iout,'(a,i3)') 'nsup=',nsup diff --git a/source/unres/src_MD/sc_move.F b/source/unres/src_MD/sc_move.F index 74e9bf2..274767b 100644 --- a/source/unres/src_MD/sc_move.F +++ b/source/unres/src_MD/sc_move.F @@ -213,7 +213,7 @@ c Define what is meant by "neighbouring side-chain" c Don't do glycine or ends i=itype(res_pick) - if (i.eq.10 .or. i.eq.21) return + if (i.eq.10 .or. i.eq.ntyp1) return c Freeze everything (later will relax only selected side-chains) mask_r=.true. diff --git a/source/unres/src_MD/stochfric.F b/source/unres/src_MD/stochfric.F index e1d3c26..cda93c3 100644 --- a/source/unres/src_MD/stochfric.F +++ b/source/unres/src_MD/stochfric.F @@ -223,7 +223,7 @@ c Compute the stochastic forces acting on virtual-bond vectors. do j=1,3 ff(j)=ff(j)+force(j,i) enddo - if (itype(i+1).ne.21) then + if (itype(i+1).ne.ntyp1) then do j=1,3 stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1) ff(j)=ff(j)+force(j,i+nres+1) diff --git a/source/unres/src_MD/thread.F b/source/unres/src_MD/thread.F index 9f169a0..f713744 100644 --- a/source/unres/src_MD/thread.F +++ b/source/unres/src_MD/thread.F @@ -146,14 +146,14 @@ cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr, cd non_conv) cd write (iout,'(a,f10.5)') cd & 'Initial RMS deviation from reference structure:',rms - if (itype(nres).eq.21) then + if (itype(nres).eq.ntyp1) then do j=1,3 dcj=c(j,nres-2)-c(j,nres-3) c(j,nres)=c(j,nres-1)+dcj c(j,2*nres)=c(j,nres) enddo endif - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then do j=1,3 dcj=c(j,4)-c(j,3) c(j,1)=c(j,2)-dcj -- 1.7.9.5