first introduction of valence constrains - not working yet
[unres.git] / source / unres / src_MD-M / readrtns_CSA.F
index 71e3468..286cc57 100644 (file)
@@ -96,6 +96,10 @@ c      print *,"Processor",me," fg_rank",fg_rank," out1file",out1file
 C Set up the time limit (caution! The time must be input in minutes!)
       read_cart=index(controlcard,'READ_CART').gt.0
       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
+C this variable with_theta_constr is the variable which allow to read and execute the
+C constrains on theta angles WITH_THETA_CONSTR is the keyword
+      with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
+      write (iout,*) "with_theta_constr ",with_theta_constr
       call readi(controlcard,'SYM',symetr,1)
       call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours
       unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
@@ -295,11 +299,11 @@ cd       endif
           do i=1,nrep
            iremd_m_total=iremd_m_total+remd_m(i)
           enddo
-          write (iout,*) 'Total number of replicas ',iremd_m_total
+           write (iout,*) 'Total number of replicas ',iremd_m_total
+          endif
          endif
-      endif
       if(me.eq.king.or..not.out1file) 
-     & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
+     &   write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
       return
       end
 c--------------------------------------------------------------------------
@@ -345,6 +349,7 @@ C
       rest = index(controlcard,"REST").gt.0
       tbf = index(controlcard,"TBF").gt.0
       usampl = index(controlcard,"USAMPL").gt.0
+
       mdpdb = index(controlcard,"MDPDB").gt.0
       call reada(controlcard,"T_BATH",t_bath,300.0d0)
       call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1) 
@@ -538,7 +543,7 @@ C
       integer rescode
       double precision x(maxvar)
       character*256 pdbfile
-      character*320 weightcard
+      character*400 weightcard
       character*80 weightcard_t,ucase
       dimension itype_pdb(maxres)
       common /pizda/ itype_pdb
@@ -550,54 +555,54 @@ C
 C Body
 C
 C Read weights of the subsequent energy terms.
-      call card_concat(weightcard)
-      call reada(weightcard,'WLONG',wlong,1.0D0)
-      call reada(weightcard,'WSC',wsc,wlong)
-      call reada(weightcard,'WSCP',wscp,wlong)
-      call reada(weightcard,'WELEC',welec,1.0D0)
-      call reada(weightcard,'WVDWPP',wvdwpp,welec)
-      call reada(weightcard,'WEL_LOC',wel_loc,1.0D0)
-      call reada(weightcard,'WCORR4',wcorr4,0.0D0)
-      call reada(weightcard,'WCORR5',wcorr5,0.0D0)
-      call reada(weightcard,'WCORR6',wcorr6,0.0D0)
-      call reada(weightcard,'WTURN3',wturn3,1.0D0)
-      call reada(weightcard,'WTURN4',wturn4,1.0D0)
-      call reada(weightcard,'WTURN6',wturn6,1.0D0)
-      call reada(weightcard,'WSCCOR',wsccor,1.0D0)
-      call reada(weightcard,'WSTRAIN',wstrain,1.0D0)
-      call reada(weightcard,'WBOND',wbond,1.0D0)
-      call reada(weightcard,'WTOR',wtor,1.0D0)
-      call reada(weightcard,'WTORD',wtor_d,1.0D0)
-      call reada(weightcard,'WANG',wang,1.0D0)
-      call reada(weightcard,'WSCLOC',wscloc,1.0D0)
-      call reada(weightcard,'SCAL14',scal14,0.4D0)
-      call reada(weightcard,'SCALSCP',scalscp,1.0d0)
-      call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
-      call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
-      call reada(weightcard,'TEMP0',temp0,300.0d0)
-      if (index(weightcard,'SOFT').gt.0) ipot=6
+       call card_concat(weightcard)
+       call reada(weightcard,'WLONG',wlong,1.0D0)
+       call reada(weightcard,'WSC',wsc,wlong)
+       call reada(weightcard,'WSCP',wscp,wlong)
+       call reada(weightcard,'WELEC',welec,1.0D0)
+       call reada(weightcard,'WVDWPP',wvdwpp,welec)
+       call reada(weightcard,'WEL_LOC',wel_loc,1.0D0)
+       call reada(weightcard,'WCORR4',wcorr4,0.0D0)
+       call reada(weightcard,'WCORR5',wcorr5,0.0D0)
+       call reada(weightcard,'WCORR6',wcorr6,0.0D0)
+       call reada(weightcard,'WTURN3',wturn3,1.0D0)
+       call reada(weightcard,'WTURN4',wturn4,1.0D0)
+       call reada(weightcard,'WTURN6',wturn6,1.0D0)
+       call reada(weightcard,'WSCCOR',wsccor,1.0D0)
+       call reada(weightcard,'WSTRAIN',wstrain,1.0D0)
+       call reada(weightcard,'WBOND',wbond,1.0D0)
+       call reada(weightcard,'WTOR',wtor,1.0D0)
+       call reada(weightcard,'WTORD',wtor_d,1.0D0)
+       call reada(weightcard,'WANG',wang,1.0D0)
+       call reada(weightcard,'WSCLOC',wscloc,1.0D0)
+       call reada(weightcard,'SCAL14',scal14,0.4D0)
+       call reada(weightcard,'SCALSCP',scalscp,1.0d0)
+       call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
+       call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
+       call reada(weightcard,'TEMP0',temp0,300.0d0)
+       if (index(weightcard,'SOFT').gt.0) ipot=6
 C 12/1/95 Added weight for the multi-body term WCORR
-      call reada(weightcard,'WCORRH',wcorr,1.0D0)
-      if (wcorr4.gt.0.0d0) wcorr=wcorr4
-      weights(1)=wsc
-      weights(2)=wscp
-      weights(3)=welec
-      weights(4)=wcorr
-      weights(5)=wcorr5
-      weights(6)=wcorr6
-      weights(7)=wel_loc
-      weights(8)=wturn3
-      weights(9)=wturn4
-      weights(10)=wturn6
-      weights(11)=wang
-      weights(12)=wscloc
-      weights(13)=wtor
-      weights(14)=wtor_d
-      weights(15)=wstrain
-      weights(16)=wvdwpp
-      weights(17)=wbond
-      weights(18)=scal14
-      weights(21)=wsccor
+       call reada(weightcard,'WCORRH',wcorr,1.0D0)
+       if (wcorr4.gt.0.0d0) wcorr=wcorr4
+       weights(1)=wsc
+       weights(2)=wscp
+       weights(3)=welec
+       weights(4)=wcorr
+       weights(5)=wcorr5
+       weights(6)=wcorr6
+       weights(7)=wel_loc
+       weights(8)=wturn3
+       weights(9)=wturn4
+       weights(10)=wturn6
+       weights(11)=wang
+       weights(12)=wscloc
+       weights(13)=wtor
+       weights(14)=wtor_d
+       weights(15)=wstrain
+       weights(16)=wvdwpp
+       weights(17)=wbond
+       weights(18)=scal14
+       weights(21)=wsccor
       if(me.eq.king.or..not.out1file)
      & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
      &  wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
@@ -679,6 +684,14 @@ C 12/1/95 Added weight for the multi-body term WCORR
       call reada(weightcard,"V2SS",v2ss,7.61d0)
       call reada(weightcard,"V3SS",v3ss,13.7d0)
       call reada(weightcard,"EBR",ebr,-5.50D0)
+      call reada(weightcard,"ATRISS",atriss,0.301D0)
+      call reada(weightcard,"BTRISS",btriss,0.021D0)
+      call reada(weightcard,"CTRISS",ctriss,1.001D0)
+      call reada(weightcard,"DTRISS",dtriss,1.001D0)
+      write (iout,*) "ATRISS=", atriss
+      write (iout,*) "BTRISS=", btriss
+      write (iout,*) "CTRISS=", ctriss
+      write (iout,*) "DTRISS=", dtriss
       dyn_ss=(index(weightcard,'DYN_SS').gt.0)
       do i=1,maxres
         dyn_ss_mask(i)=.false.
@@ -699,7 +712,11 @@ C 12/1/95 Added weight for the multi-body term WCORR
         v2ss=v2ss*wstrain/wsc
         v3ss=v3ss*wstrain/wsc
       else
-        ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain
+        if (wstrain.ne.0.0) then
+         ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain
+        else
+          ss_depth=0.0
+        endif
       endif
 
       if(me.eq.king.or..not.out1file) then
@@ -721,9 +738,11 @@ C 12/1/95 Added weight for the multi-body term WCORR
   33    write (iout,'(a)') 'Error opening PDB file.'
         stop
   34    continue
-c        print *,'Begin reading pdb data'
+c        write (iout,*) 'Begin reading pdb data'
+c        call flush(iout)
         call readpdb
-c        print *,'Finished reading pdb data'
+c        write (iout,*) 'Finished reading pdb data'
+c        call flush(iout)
         if(me.eq.king.or..not.out1file)
      &   write (iout,'(a,i3,a,i3)')'nsup=',nsup,
      &   ' nstart_sup=',nstart_sup
@@ -813,27 +832,77 @@ C 8/13/98 Set limits to generating the dihedral angles
       enddo
       read (inp,*) ndih_constr
       if (ndih_constr.gt.0) then
-        read (inp,*) ftors
-        read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr)
+C        read (inp,*) ftors
+        read (inp,*) (idih_constr(i),phi0(i),drange(i),ftors(i),
+     &  i=1,ndih_constr)
         if(me.eq.king.or..not.out1file)then
          write (iout,*) 
      &   'There are',ndih_constr,' constraints on phi angles.'
          do i=1,ndih_constr
-          write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i)
+          write (iout,'(i5,3f8.3)') idih_constr(i),phi0(i),drange(i),
+     &    ftors(i)
          enddo
         endif
         do i=1,ndih_constr
           phi0(i)=deg2rad*phi0(i)
           drange(i)=deg2rad*drange(i)
         enddo
-        if(me.eq.king.or..not.out1file)
-     &   write (iout,*) 'FTORS',ftors
+C        if(me.eq.king.or..not.out1file)
+C     &   write (iout,*) 'FTORS',ftors
         do i=1,ndih_constr
           ii = idih_constr(i)
           phibound(1,ii) = phi0(i)-drange(i)
           phibound(2,ii) = phi0(i)+drange(i)
         enddo 
       endif
+C first setting the theta boundaries to 0 to pi
+C this mean that there is no energy penalty for any angle occuring
+      do i=1,nres
+        thetabound(1,i)=0
+        thetabound(2,i)=pi
+      enddo
+C begin reading theta constrains this is quartic constrains allowing to 
+C have smooth second derivative 
+      if (with_theta_constr) then
+C with_theta_constr is keyword allowing for occurance of theta constrains
+      read (inp,*) ntheta_constr
+C ntheta_constr is the number of theta constrains
+      if (ntheta_constr.gt.0) then
+C        read (inp,*) ftors
+        read (inp,*) (itheta_constr(i),theta_constr0(i),
+     &  theta_drange(i),for_thet_constr(i),
+     &  i=1,ntheta_constr)
+C the above code reads from 1 to ntheta_constr 
+C itheta_constr(i) residue i for which is theta_constr
+C theta_constr0 the global minimum value
+C theta_drange is range for which there is no energy penalty
+C for_thet_constr is the force constant for quartic energy penalty
+C E=k*x**4 
+        if(me.eq.king.or..not.out1file)then
+         write (iout,*)
+     &   'There are',ntheta_constr,' constraints on phi angles.'
+         do i=1,ntheta_constr
+          write (iout,'(i5,3f8.3)') itheta_constr(i),theta_constr0(i),
+     &    theta_drange(i),
+     &    for_thet_constr(i)
+         enddo
+        endif
+        do i=1,nthet_constr
+          theta_constr0(i)=deg2rad*theta_constr0(i)
+          theta_drange(i)=deg2rad*theta_drange(i)
+        enddo
+C        if(me.eq.king.or..not.out1file)
+C     &   write (iout,*) 'FTORS',ftors
+        do i=1,ntheta_constr
+          ii = itheta_constr(i)
+          thetabound(1,ii) = phi0(i)-drange(i)
+          thetabound(2,ii) = phi0(i)+drange(i)
+        enddo
+      endif ! ntheta_constr.gt.0
+      endif! with_theta_constr
+C
+C      with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
+C      write (iout,*) "with_dihed_constr ",with_dihed_constr
       nnt=1
 #ifdef MPI
       if (me.eq.king) then
@@ -920,7 +989,9 @@ czscore          call geom_to_var(nvar,coord_exp_zs(1,1))
           enddo
           call contact(.true.,ncont_ref,icont_ref,co)
         endif
-c        write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
+        endif
+        print *, "A TU"
+        write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
         call flush(iout)
         if (constr_dist.gt.0) call read_dist_constr
         write (iout,*) "After read_dist_constr nhpb",nhpb
@@ -940,7 +1011,7 @@ c        write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
      &     restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i)
         enddo
         endif
-      endif
+C      endif
       if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4
      &    .and. modecalc.ne.8 .and. modecalc.ne.9 .and. 
      &    modecalc.ne.10) then
@@ -1088,8 +1159,7 @@ C Generate distance constraints, if the PDB structure is to be regularized.
          i2=jhpb(i)-nres
          it1=itype(i1)
          it2=itype(i2)
-         if (me.eq.king.or..not.out1file)
-     &    write (iout,'(2a,i3,3a,i3,a,3f10.3)')
+          write (iout,'(2a,i3,3a,i3,a,3f10.3)')
      &    restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i),
      &    ebr,forcon(i)
        enddo
@@ -1124,6 +1194,7 @@ cd    write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar)
      &  write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)') 
      &  'Processor',myrank,': end reading molecular data.'
 #endif
+      print *,"A TU?"
       return
       end
 c--------------------------------------------------------------------------
@@ -1165,7 +1236,7 @@ C Read information about disulfide bridges.
       include 'COMMON.SETUP'
 C Read bridging residues.
       read (inp,*) ns,(iss(i),i=1,ns)
-c      print *,'ns=',ns
+      print *,'ns=',ns
       if(me.eq.king.or..not.out1file)
      &  write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns)
 C Check whether the specified bridging residues are cystines.
@@ -2247,7 +2318,8 @@ c-------------------------------------------------------------------------------
       integer ifrag_(2,100),ipair_(2,100)
       double precision wfrag_(100),wpair_(100)
       character*500 controlcard
-c      write (iout,*) "Calling read_dist_constr"
+      print *, "WCHODZE"
+      write (iout,*) "Calling read_dist_constr"
 c      write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
 c      call flush(iout)
       call card_concat(controlcard)
@@ -2281,11 +2353,11 @@ c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
 c            write (iout,*) "j",j," k",k
             ddjk=dist(j,k)
             if (constr_dist.eq.1) then
-              nhpb=nhpb+1
-              ihpb(nhpb)=j
-              jhpb(nhpb)=k
+            nhpb=nhpb+1
+            ihpb(nhpb)=j
+            jhpb(nhpb)=k
               dhpb(nhpb)=ddjk
-              forcon(nhpb)=wfrag_(i) 
+            forcon(nhpb)=wfrag_(i) 
             else if (constr_dist.eq.2) then
               if (ddjk.le.dist_cut) then
                 nhpb=nhpb+1
@@ -2341,11 +2413,30 @@ c            write (iout,*) "j",j," k",k
         enddo
         endif
       enddo 
+      print *,ndist_
       do i=1,ndist_
-        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+        if (constr_dist.eq.11) then
+        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+     &     ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1)
+        fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1)
+        else
+C        print *,"in else"
+        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+     &     ibecarb(i),forcon(nhpb+1)
+        endif
         if (forcon(nhpb+1).gt.0.0d0) then
           nhpb=nhpb+1
-          dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+          if (ibecarb(i).gt.0) then
+            ihpb(i)=ihpb(i)+nres
+            jhpb(i)=jhpb(i)+nres
+          endif
+          if (dhpb(nhpb).eq.0.0d0)
+     &       dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
+        endif
+C        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+C        if (forcon(nhpb+1).gt.0.0d0) then
+C          nhpb=nhpb+1
+C          dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
 #ifdef MPI
           if (.not.out1file .or. me.eq.king)
      &    write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
@@ -2354,7 +2445,7 @@ c            write (iout,*) "j",j," k",k
           write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
      &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
 #endif
-        endif
+
       enddo
       call flush(iout)
       return
@@ -2463,7 +2554,7 @@ C
 #endif
       if (OKRandom) then
 c        r1 = prng_next(me)
-         r1=ran_number(0.0D0,1.0D0)
+        r1=ran_number(0.0D0,1.0D0)
         if(me.eq.king)
      &   write (iout,*) 'ran_num',r1
         if (r1.lt.0.0d0) OKRandom=.false.