Merge branch 'prerelease-3.2.1' of mmka.chem.univ.gda.pl:unres into prerelease-3.2.1
[unres.git] / source / unres / src_CSA_DiL / csa.F
diff --git a/source/unres/src_CSA_DiL/csa.F b/source/unres/src_CSA_DiL/csa.F
new file mode 100644 (file)
index 0000000..a5149f2
--- /dev/null
@@ -0,0 +1,366 @@
+      subroutine make_array
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.INTERACT'
+      include 'COMMON.CSA'
+
+ccccccccccccccccccccccccc
+c Level-2: group
+ccccccccccccccccccccccccc
+
+      indg=0
+      do k=1,numch
+ccccccccccccccccccccccccccccccccccccccccc
+! Groups the THETAs and the GAMMAs
+       do j=2,nres-1
+         indg=indg+1
+         if (j.lt.nres-1) then
+           ngroup(indg)=2
+         else
+           ngroup(indg)=1
+         endif
+         do i=1,ngroup(indg)
+          igroup(1,i,indg)=i
+          igroup(2,i,indg)=j
+          igroup(3,i,indg)=k
+         enddo
+       enddo
+ccccccccccccccccccccccccccccccccccccccccc
+      enddo
+! Groups the ALPHAs and the BETAs
+      do k=1,numch
+       do j=2,nres-1
+        if(itype(j).ne.10) then
+         indg=indg+1
+         ngroup(indg)=2
+         do i=1,ngroup(indg)
+          igroup(1,i,indg)=i+2
+          igroup(2,i,indg)=j
+          igroup(3,i,indg)=k
+         enddo
+        endif
+       enddo
+      enddo
+
+      ntotgr=indg
+      write(iout,*) 
+      write(iout,*) "# of groups: ",ntotgr
+      do i=1,ntotgr
+       write(iout,41) i,ngroup(i),((igroup(k,j,i),k=1,3),j=1,ngroup(i))
+      enddo
+!      close(iout)
+
+   40 format(i3,3x,3i3)
+   41 format(2i3,3x,6(3i3,2x))
+
+      return
+      end
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine make_ranvar(n,m,idum)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.BANK'
+c al      m=0
+      print *,'HOHOHOHO Make_RanVar!!!!!',n,m
+      itrial=0
+      do while(m.lt.n .and. itrial.le.10000)
+        itrial=itrial+1
+        jeden=1
+        call gen_rand_conf(jeden,*10)
+        call intout
+        m=m+1
+        do j=2,nres-1
+          dihang_in(1,j,1,m)=theta(j+1)
+          dihang_in(2,j,1,m)=phi(j+2)
+          dihang_in(3,j,1,m)=alph(j)
+          dihang_in(4,j,1,m)=omeg(j)
+        enddo  
+        dihang_in(2,nres-1,1,m)=0.0d0
+        goto 20
+  10    write (iout,*) 'Failed to generate conformation #',m+1,
+     &   ' itrial=',itrial
+  20    continue
+      enddo
+      print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
+
+      return
+      end
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine make_ranvar_reg(n,idum)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.BANK'
+      include 'COMMON.GEO'
+      m=0
+      print *,'HOHOHOHO Make_RanVar_reg!!!!!'
+      itrial=0
+      do while(m.lt.n .and. itrial.le.10000)
+        itrial=itrial+1
+        jeden=1
+        call gen_rand_conf(jeden,*10)
+!        call intout
+        m=m+1
+        do j=2,nres-1
+          dihang_in(1,j,1,m)=theta(j+1)
+          dihang_in(2,j,1,m)=phi(j+2)
+          dihang_in(3,j,1,m)=alph(j)
+          dihang_in(4,j,1,m)=omeg(j)
+          if(m.le.n*0.1) then
+           dihang_in(1,j,1,m)=90.0*deg2rad
+           dihang_in(2,j,1,m)=50.0*deg2rad
+          endif
+        enddo  
+        dihang_in(2,nres-1,1,m)=0.0d0
+        goto 20
+  10    write (iout,*) 'Failed to generate conformation #',m+1,
+     &   ' itrial=',itrial
+  20    continue
+      enddo
+      print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
+
+      return
+      end
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine from_pdb(n,idum)
+c This subroutine stores the UNRES int variables generated from 
+c subroutine readpdb into the 1st conformation of in dihang_in.
+c Subsequent n-1 conformations of dihang_in have identical values
+c of theta and phi as the 1st conformation but random values for
+c alph and omeg.
+c The array cref (also generated from subroutine readpdb) is stored
+c to crefjlee to be used for rmsd calculation in CSA, if necessary.
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.BANK'
+      include 'COMMON.GEO'
+
+      m=1
+      do j=2,nres-1
+        dihang_in(1,j,1,m)=theta(j+1)
+        dihang_in(2,j,1,m)=phi(j+2)
+        dihang_in(3,j,1,m)=alph(j)
+        dihang_in(4,j,1,m)=omeg(j)
+      enddo
+      dihang_in(2,nres-1,1,k)=0.0d0
+
+      do m=2,n
+       do k=2,nres-1
+        dihang_in(1,k,1,m)=dihang_in(1,k,1,1)
+        dihang_in(2,k,1,m)=dihang_in(2,k,1,1)
+        if(dabs(dihang_in(3,k,1,1)).gt.1.d-6) then
+         dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0
+         dihang_in(3,k,1,m)=dihang_in(3,k,1,m)*deg2rad
+        endif
+        if(dabs(dihang_in(4,k,1,1)).gt.1.d-6) then
+         dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0
+         dihang_in(4,k,1,m)=dihang_in(4,k,1,m)*deg2rad
+        endif
+       enddo
+      enddo
+
+c Store cref to crefjlee (they are in COMMON.CHAIN).
+      do k=1,2*nres
+       do kk=1,3
+        crefjlee(kk,k)=cref(kk,k)
+       enddo
+      enddo
+
+      open(icsa_native_int,file=csa_native_int,status="old")
+      do m=1,n
+        write(icsa_native_int,*) m,e
+         write(icsa_native_int,200) 
+     &    (dihang_in(1,k,1,m)*rad2deg,k=2,nres-1)
+         write(icsa_native_int,200) 
+     &    (dihang_in(2,k,1,m)*rad2deg,k=2,nres-2)
+         write(icsa_native_int,200) 
+     &    (dihang_in(3,k,1,m)*rad2deg,k=2,nres-1)
+         write(icsa_native_int,200) 
+     &    (dihang_in(4,k,1,m)*rad2deg,k=2,nres-1)
+      enddo
+
+      do k=1,nres
+       write(icsa_native_int,200) (crefjlee(i,k),i=1,3)
+      enddo
+      close(icsa_native_int)
+
+  200 format (8f10.4)
+
+      return
+      end
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine from_int(n,mm,idum)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.CHAIN'
+      include 'COMMON.VAR'
+      include 'COMMON.INTERACT'
+      include 'COMMON.BANK'
+      include 'COMMON.GEO'
+      include 'COMMON.CONTACTS'
+#ifdef MOMENT
+      include 'COMMON.CONTACTS.MOMENT'
+#endif 
+      integer ilen
+      external ilen
+      logical fail
+      double precision energia(0:n_ene)
+
+      open(icsa_native_int,file=csa_native_int,status="old")
+      read (icsa_native_int,*)
+      call read_angles(icsa_native_int,*10)
+      goto 11
+   10 write (iout,'(2a)') "CHUJ NASTAPIL - error in ",
+     &  csa_native_int(:ilen(csa_native_int))
+   11 continue
+      call intout
+      do j=2,nres-1
+        dihang_in(1,j,1,1)=theta(j+1)
+        dihang_in(2,j,1,1)=phi(j+2)
+        dihang_in(3,j,1,1)=alph(j)
+        dihang_in(4,j,1,1)=omeg(j)
+      enddo
+      dihang_in(2,nres-1,1,1)=0.0d0
+
+c         read(icsa_native_int,*) ind,e
+c         read(icsa_native_int,200) (dihang_in(1,k,1,1),k=2,nres-1)
+c         read(icsa_native_int,200) (dihang_in(2,k,1,1),k=2,nres-2)
+c         read(icsa_native_int,200) (dihang_in(3,k,1,1),k=2,nres-1)
+c         read(icsa_native_int,200) (dihang_in(4,k,1,1),k=2,nres-1)
+c         dihang_in(2,nres-1,1,1)=0.d0
+
+         maxsi=100
+         maxcount_fail=100
+
+         do m=mm+2,n
+c          do k=2,nres-1
+c           dihang_in(1,k,1,m)=dihang_in(1,k,1,1)
+c           dihang_in(2,k,1,m)=dihang_in(2,k,1,1)
+c           if(abs(dihang_in(3,k,1,1)).gt.1.d-3) then
+c            dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0
+c           endif
+c           if(abs(dihang_in(4,k,1,1)).gt.1.d-3) then
+c            dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0
+c           endif
+c          enddo
+c           call intout
+           fail=.true.
+
+           icount_fail=0
+
+           DO WHILE (FAIL .AND. ICOUNT_FAIL .LE. MAXCOUNT_FAIL)
+
+           do i=nnt,nct
+             if (itype(i).ne.10) then
+cd             print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1)
+               fail=.true.
+               ii=0
+               do while (fail .and. ii .le. maxsi)
+                 call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail)
+                 ii = ii+1
+               enddo
+             endif
+           enddo
+           call chainbuild
+           call etotal(energia(0))
+           fail = (energia(0).ge.1.0d20)
+           icount_fail=icount_fail+1
+
+           ENDDO
+
+           if (icount_fail.gt.maxcount_fail) then
+             write (iout,*) 
+     &       'Failed to generate non-overlaping near-native conf.',
+     &       m
+           endif
+
+           do j=2,nres-1
+             dihang_in(1,j,1,m)=theta(j+1)
+             dihang_in(2,j,1,m)=phi(j+2)
+             dihang_in(3,j,1,m)=alph(j)
+             dihang_in(4,j,1,m)=omeg(j)
+           enddo
+           dihang_in(2,nres-1,1,m)=0.0d0
+         enddo
+
+c      do m=1,n
+c       write(icsa_native_int,*) m,e
+c         write(icsa_native_int,200) (dihang_in(1,k,1,m),k=2,nres-1)
+c         write(icsa_native_int,200) (dihang_in(2,k,1,m),k=2,nres-2)
+c         write(icsa_native_int,200) (dihang_in(3,k,1,m),k=2,nres-1)
+c         write(icsa_native_int,200) (dihang_in(4,k,1,m),k=2,nres-1)
+c      enddo
+c     close(icsa_native_int)
+
+c      do m=mm+2,n
+c       do i=1,4
+c        do j=2,nres-1
+c         dihang_in(i,j,1,m)=dihang_in(i,j,1,m)*deg2rad
+c        enddo
+c       enddo
+c      enddo
+
+      call dihang_to_c(dihang_in(1,1,1,1))
+
+c Store c to cref (they are in COMMON.CHAIN).
+      do k=1,2*nres
+       do kk=1,3
+        crefjlee(kk,k)=c(kk,k)
+       enddo
+      enddo
+
+      call contact(.true.,ncont_ref,icont_ref,co)
+
+c      do k=1,nres
+c       write(icsa_native_int,200) (crefjlee(i,k),i=1,3)
+c      enddo
+      close(icsa_native_int)
+
+  200 format (8f10.4)
+
+      return
+      end
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+      subroutine dihang_to_c(aarray)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.CSA'
+      include 'COMMON.BANK'
+      include 'COMMON.CHAIN'
+      include 'COMMON.GEO'
+      include 'COMMON.VAR'
+
+      dimension aarray(mxang,maxres,mxch)
+
+c     do i=4,nres
+c      phi(i)=dihang_in(1,i-2,1,1)
+c     enddo
+      do i=2,nres-1
+       theta(i+1)=aarray(1,i,1)
+       phi(i+2)=aarray(2,i,1)
+       alph(i)=aarray(3,i,1)
+       omeg(i)=aarray(4,i,1)
+      enddo
+
+      call chainbuild
+
+      return
+      end
+ccccccccccccccccccccccccccccccccccccccccccccccccc
+ccccccccccccccccccccccccccccccccccccccccccccccccc