working energy for shield and lipid wrong gradient
[unres4.git] / source / unres / io_config.f90
index aedb3dd..0dce2e1 100644 (file)
 
       use geometry_data
       use energy_data
-      use control_data, only:maxtor,maxterm
+      use control_data, only:maxterm !,maxtor
       use MD_data
       use MPI_data
 !el      use map_data
       real(kind=8) :: v0ijsccor,v0ijsccor1,v0ijsccor2,v0ijsccor3,si,&
                 dwa16,rjunk,akl,v0ij,rri,epsij,rrij,sigeps,sigt1sq,&
                 sigt2sq,sigii1,sigii2,ratsig1,ratsig2,rsum_max,r_augm,&
-                res1
+                res1,epsijlip
       integer :: ichir1,ichir2
 !      real(kind=8),dimension(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) :: v1_el,v2_el !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2)
 !el      allocate(v1_el(maxterm,-maxtor:maxtor,-maxtor:maxtor,2))
       allocate(isc(ntyp+1)) !(ntyp+1)
       allocate(restok(ntyp+1)) !(ntyp+1)
       allocate(abond0(maxbondterm,ntyp)) !(maxbondterm,ntyp)
-
+      allocate(long_r_sidechain(ntyp))
+      allocate(short_r_sidechain(ntyp))
       dsc(:)=0.0d0
       dsc_inv(:)=0.0d0
 
         endif
       enddo
 #else
-      read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok
+      read (ibond,*) junk,vbldp0,vbldpDUM,akp,rjunk,mp,ip,pstok
       do i=1,ntyp
         read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),&
          j=1,nbondterm(i)),msc(i),isc(i),restok(i)
       theta0(:)=0.0D0
       sig0(:)=0.0D0
       sigc0(:)=0.0D0
+      allocate(liptranene(ntyp))
+!C reading lipid parameters
+      write (iout,*) "iliptranpar",iliptranpar
+      call flush(iout)
+       read(iliptranpar,*) pepliptran
+       print *,pepliptran
+       do i=1,ntyp
+       read(iliptranpar,*) liptranene(i)
+        print *,liptranene(i)
+       enddo
+       close(iliptranpar)
 
 #ifdef CRYST_THETA
 !
 
 !----------------------------------------------------
       allocate(ithetyp(-ntyp1:ntyp1)) !(-ntyp1:ntyp1)
-      allocate(aa0thet(-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
+      allocate(aa0thet(-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
 !(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
-      allocate(aathet(ntheterm,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
+      allocate(aathet(ntheterm,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
 !(maxtheterm,-maxthetyp1:maxthetyp1,&
 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
-      allocate(bbthet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
-      allocate(ccthet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
-      allocate(ddthet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
-      allocate(eethet(nsingle,ntheterm2,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
+      allocate(bbthet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
+      allocate(ccthet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
+      allocate(ddthet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
+      allocate(eethet(nsingle,ntheterm2,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
 !(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1,&
 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2)
-      allocate(ffthet(ndouble,ndouble,ntheterm3,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
-      allocate(ggthet(ndouble,ndouble,ntheterm3,-maxthetyp1:maxthetyp1,&
-        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
+      allocate(ffthet(ndouble,ndouble,ntheterm3,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
+      allocate(ggthet(ndouble,ndouble,ntheterm3,-nthetyp-1:nthetyp+1,&
+        -nthetyp-1:nthetyp+1,-nthetyp-1:nthetyp+1,2))
 !(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1,&
 !        -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2))
 
       do i=-ntyp,-1
        itortyp(i)=-itortyp(-i)
       enddo
-!      itortyp(ntyp1)=ntortyp
-!      itortyp(-ntyp1)=-ntortyp
+      itortyp(ntyp1)=ntortyp
+      itortyp(-ntyp1)=-ntortyp
       do iblock=1,2 
       write (iout,*) 'ntortyp',ntortyp
       do i=0,ntortyp-1
       allocate(eps_scp(ntyp,2),rscp(ntyp,2)) !(ntyp,2)
       allocate(sigma0(ntyp),rr0(ntyp),sigii(ntyp)) !(ntyp)
       allocate(chip(ntyp1),alp(ntyp1)) !(ntyp)
-
+      allocate(epslip(ntyp,ntyp))
       augm(:,:)=0.0D0
       chip(:)=0.0D0
       alp(:)=0.0D0
         read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp)
         read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp)
         read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp)
+        do i=1,ntyp
+         read (isidep,*,end=117,err=117)(epslip(i,j),j=i,ntyp)
+        enddo
+
 ! For the GB potential convert sigma'**2 into chi'
         if (ipot.eq.4) then
          do i=1,ntyp
 ! Calculate the "working" parameters of SC interactions.
 
 !el from module energy - COMMON.INTERACT-------
-      allocate(aa(ntyp1,ntyp1),bb(ntyp1,ntyp1),chi(ntyp1,ntyp1)) !(ntyp,ntyp)
+      allocate(aa_aq(ntyp1,ntyp1),bb_aq(ntyp1,ntyp1),chi(ntyp1,ntyp1)) !(ntyp,ntyp)
+      allocate(aa_lip(ntyp1,ntyp1),bb_lip(ntyp1,ntyp1)) !(ntyp,ntyp)
       allocate(sigma(0:ntyp1,0:ntyp1),r0(ntyp1,ntyp1)) !(0:ntyp1,0:ntyp1)
-      aa(:,:)=0.0D0
-      bb(:,:)=0.0D0
+      aa_aq(:,:)=0.0D0
+      bb_aq(:,:)=0.0D0
+      aa_lip(:,:)=0.0D0
+      bb_lip(:,:)=0.0D0
       chi(:,:)=0.0D0
       sigma(:,:)=0.0D0
       r0(:,:)=0.0D0
       do i=2,ntyp
         do j=1,i-1
           eps(i,j)=eps(j,i)
+          epslip(i,j)=epslip(j,i)
         enddo
       enddo
       do i=1,ntyp
          epsij=eps(i,j)
          sigeps=dsign(1.0D0,epsij)
          epsij=dabs(epsij)
-         aa(i,j)=epsij*rrij*rrij
-         bb(i,j)=-sigeps*epsij*rrij
-         aa(j,i)=aa(i,j)
-         bb(j,i)=bb(i,j)
+         aa_aq(i,j)=epsij*rrij*rrij
+         bb_aq(i,j)=-sigeps*epsij*rrij
+         aa_aq(j,i)=aa_aq(i,j)
+         bb_aq(j,i)=bb_aq(i,j)
+          epsijlip=epslip(i,j)
+          sigeps=dsign(1.0D0,epsijlip)
+          epsijlip=dabs(epsijlip)
+          aa_lip(i,j)=epsijlip*rrij*rrij
+          bb_lip(i,j)=-sigeps*epsijlip*rrij
+          aa_lip(j,i)=aa_lip(i,j)
+          bb_lip(j,i)=bb_lip(i,j)
+!C          write(iout,*) aa_lip
          if (ipot.gt.2) then
            sigt1sq=sigma0(i)**2
            sigt2sq=sigma0(j)**2
           endif
          if (lprint) then
             write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') &
-            restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j),&
+            restyp(i),restyp(j),aa_aq(i,j),bb_aq(i,j),augm(i,j),&
             sigma(i,j),r0(i,j),chi(i,j),chi(j,i)
          endif
         enddo
           goto 10
         else if (card(:3).eq.'TER') then
 ! End current chain
-          ires_old=ires+1
+          ires_old=ires+2
           ishift1=ishift1+1
           itype(ires_old)=ntyp1
+          itype(ires_old-1)=ntyp1
           ibeg=2
 !          write (iout,*) "Chain ended",ires,ishift,ires_old
           if (unres_pdb) then
             enddo
           else
             call sccenter(ires,iii,sccor)
+!          iii=0
           endif
           iii=0
         endif
 !              write (iout,*) "Calculating sidechain center iii",iii
               if (unres_pdb) then
                 do j=1,3
-                  dc(j,ires+nres)=sccor(j,iii)
+                  dc(j,ires+ishift1-ishift-1)=sccor(j,iii)
                 enddo
               else
                 call sccenter(ires_old,iii,sccor)
       nres=ires
       do i=2,nres-1
 !        write (iout,*) i,itype(i)
-        if (itype(i).eq.ntyp1) then
+!        if (itype(i).eq.ntyp1) then
 !          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
+!          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
 !            c(j,i)=(c(j,i-1)+c(j,i+1))/2
-            dc(j,i)=c(j,i)
-          enddo
-        endif
+!            dc(j,i)=c(j,i)
+!          enddo
+!        endif
+        if (itype(i).eq.ntyp1) then
+         if (itype(i+1).eq.ntyp1) then
+! 16/01/2014 by Adasko: Adding to dummy atoms in the chain
+! first is connected prevous chain (itype(i+1).eq.ntyp1)=true
+! second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false
+           if (unres_pdb) then
+! 2/15/2013 by Adam: corrected insertion of the last dummy residue
+!            print *,i,'tu dochodze'
+            call refsys(i-3,i-2,i-1,e1,e2,e3,fail)
+            if (fail) then
+              e2(1)=0.0d0
+              e2(2)=1.0d0
+              e2(3)=0.0d0
+            endif !fail
+            print *,i,'a tu?'
+            do j=1,3
+             c(j,i)=c(j,i-1)-1.9d0*e2(j)
+            enddo
+           else   !unres_pdb
+           do j=1,3
+             dcj=(c(j,i-2)-c(j,i-3))/2.0
+            if (dcj.eq.0) dcj=1.23591524223
+             c(j,i)=c(j,i-1)+dcj
+             c(j,nres+i)=c(j,i)
+           enddo
+          endif   !unres_pdb
+         else     !itype(i+1).eq.ntyp1
+          if (unres_pdb) then
+! 2/15/2013 by Adam: corrected insertion of the first dummy residue
+            call refsys(i+1,i+2,i+3,e1,e2,e3,fail)
+            if (fail) then
+              e2(1)=0.0d0
+              e2(2)=1.0d0
+              e2(3)=0.0d0
+            endif
+            do j=1,3
+              c(j,i)=c(j,i+1)-1.9d0*e2(j)
+            enddo
+          else !unres_pdb
+           do j=1,3
+            dcj=(c(j,i+3)-c(j,i+2))/2.0
+            if (dcj.eq.0) dcj=1.23591524223
+            c(j,i)=c(j,i+1)-dcj
+            c(j,nres+i)=c(j,i)
+           enddo
+          endif !unres_pdb
+         endif !itype(i+1).eq.ntyp1
+        endif  !itype.eq.ntyp1
+
       enddo
 ! Calculate the CM of the last side chain.
       if (iii.gt.0)  then
             e2(3)=0.0d0
           endif
           do j=1,3
-            c(j,nres)=c(j,nres-1)-3.8d0*e2(j)
+            c(j,nres)=c(j,nres-1)-1.9d0*e2(j)
           enddo
         else
         do j=1,3
-          dcj=c(j,nres-2)-c(j,nres-3)
+          dcj=(c(j,nres-2)-c(j,nres-3))/2.0
           c(j,nres)=c(j,nres-1)+dcj
           c(j,2*nres)=c(j,nres)
         enddo
             e2(3)=0.0d0
           endif
           do j=1,3
-            c(j,1)=c(j,2)-3.8d0*e2(j)
+            c(j,1)=c(j,2)-1.9d0*e2(j)
           enddo
         else
         do j=1,3
-          dcj=c(j,4)-c(j,3)
+          dcj=(c(j,4)-c(j,3))/2.0
           c(j,1)=c(j,2)-dcj
           c(j,nres+1)=c(j,1)
         enddo
 ! enddiagnostic
 ! makes copy of chains
         write (iout,*) "symetr", symetr
+      do j=1,3
+      dc(j,0)=c(j,1)
+      enddo
 
       if (symetr.gt.1) then
        call permut(symetr)
       character(len=640) :: controlcard
 
       real(kind=8) :: seed,rmsdbc,rmsdbc1max,rmsdbcm,drms,timem!,&
-                 
+      integer i                 
 
       nglob_csa=0
       eglob_csa=1d99
       timem=timlim
       modecalc=0
       call reada(controlcard,"T_BATH",t_bath,300.0d0)
+!C SHIELD keyword sets if the shielding effect of side-chains is used
+!C 0 denots no shielding is used all peptide are equally despite the 
+!C solvent accesible area
+!C 1 the newly introduced function
+!C 2 reseved for further possible developement
+      call readi(controlcard,'SHIELD',shield_mode,0)
+!C      if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
+        write(iout,*) "shield_mode",shield_mode
+!C  Varibles set size of box
+      call reada(controlcard,'BOXX',boxxsize,100.0d0)
+      call reada(controlcard,'BOXY',boxysize,100.0d0)
+      call reada(controlcard,'BOXZ',boxzsize,100.0d0)
+! CUTOFFF ON ELECTROSTATICS
+      call reada(controlcard,"R_CUT_ELE",r_cut_ele,15.0d0)
+      call reada(controlcard,"LAMBDA_ELE",rlamb_ele,0.3d0)
+      write(iout,*) "R_CUT_ELE=",r_cut_ele
+! Lipidic parameters
+      call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
+      call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
+      if (lipthick.gt.0.0d0) then
+       bordliptop=(boxzsize+lipthick)/2.0
+       bordlipbot=bordliptop-lipthick
+      if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0)) &
+      write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
+      buflipbot=bordlipbot+lipbufthick
+      bufliptop=bordliptop-lipbufthick
+      if ((lipbufthick*2.0d0).gt.lipthick) &
+       write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
+      endif !lipthick.gt.0
+      write(iout,*) "bordliptop=",bordliptop
+      write(iout,*) "bordlipbot=",bordlipbot
+      write(iout,*) "bufliptop=",bufliptop
+      write(iout,*) "buflipbot=",buflipbot
+      write (iout,*) "SHIELD MODE",shield_mode
+
+!C-------------------------
       minim=(index(controlcard,'MINIMIZE').gt.0)
       dccart=(index(controlcard,'CART').gt.0)
       overlapsc=(index(controlcard,'OVERLAP').gt.0)
       if(me.eq.king.or..not.out1file) &
        write (iout,'(2a)') diagmeth(kdiag),&
         ' routine used to diagonalize matrices.'
+      if (shield_mode.gt.0) then
+      pi=3.141592d0
+!C VSolvSphere the volume of solving sphere
+!C      print *,pi,"pi"
+!C rpp(1,1) is the energy r0 for peptide group contact and will be used for it 
+!C there will be no distinction between proline peptide group and normal peptide
+!C group in case of shielding parameters
+      VSolvSphere=4.0/3.0*pi*rpp(1,1)**3
+      VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3
+      write (iout,*) VSolvSphere,VSolvSphere_div
+!C long axis of side chain 
+      do i=1,ntyp
+      long_r_sidechain(i)=vbldsc0(1,i)
+      short_r_sidechain(i)=sigma0(i)
+      write(iout,*) "parame for long and short axis",i,vbldsc0(1,i),&
+         sigma0(i) 
+      enddo
+      buff_shield=1.0d0
+      endif
       return
       end subroutine read_control
 !-----------------------------------------------------------------------------
 !-----------------------------------------------------------------------------
       subroutine openunits
 
-      use energy_data, only: usampl
+      use MD_data, only: usampl
       use csa_data
       use MPI_data
       use control_data, only:out1file
 !      print *,"Processor",myrank," opened file IELEP" 
       call getenv_loc('SIDEPAR',sidename)
       open (isidep,file=sidename,status='old',action='read')
+      call getenv_loc('LIPTRANPAR',liptranname)
+      open (iliptranpar,file=liptranname,status='old',action='read')
 !      print *,"Processor",myrank," opened file ISIDEP" 
 !      print *,"Processor",myrank," opened parameter files" 
 #elif (defined G77)
       open (ielep,file=elename,status='old')
       call getenv_loc('SIDEPAR',sidename)
       open (isidep,file=sidename,status='old')
+      call getenv_loc('LIPTRANPAR',liptranname)
+      open (iliptranpar,file=liptranname,status='old')
 #else
       open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',&
         readonly)
       open (ielep,file=elename,status='old',readonly)
       call getenv_loc('SIDEPAR',sidename)
       open (isidep,file=sidename,status='old',readonly)
+      call getenv_loc('LIPTRANPAR',liptranname)
+      open (iliptranpar,file=liptranname,status='old',action='read')
 #ifndef CRYST_SC
       call getenv_loc('ROTPARPDB',rotname_pdb)
       open (irotam_pdb,file=rotname_pdb,status='old',action='read')
       subroutine readrst
 
       use geometry_data, only: nres,dc
-      use energy_data, only: usampl,iset
       use MD_data
 !      implicit real*8 (a-h,o-z)
 !      include 'DIMENSIONS'
 
       open(irest2,file=rest2name,status='unknown')
       read(irest2,*) totT,EK,potE,totE,t_bath
-      do i=1,2*nres
+!      do i=1,2*nres
+! AL 4/17/17: Now reading d_t(0,:) too
+      do i=0,2*nres
          read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
       enddo
-      do i=1,2*nres
+!      do i=1,2*nres
+! AL 4/17/17: Now reading d_c(0,:) too
+      do i=0,2*nres
          read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
       enddo
       if(usampl) then