Backup before merge with adasko
[unres.git] / source / unres / src_MD / readrtns.F
index 684c376..d784218 100644 (file)
@@ -44,7 +44,8 @@ C Print restraint information
      &write (iout,'(a,i5,a)') "The following",nhpb-nss,
      & " distance constraints have been imposed"
       do i=nss+1,nhpb
-        write (iout,'(3i6,f10.5)') i-nss,ihpb(i),jhpb(i),forcon(i)
+        write (iout,'(3i6,i2,3f10.5)') i-nss,ihpb(i),jhpb(i),
+     &     ibecarb(i),dhpb(i),dhpb1(i),forcon(i)
       enddo
 #ifdef MPI
       endif
@@ -137,7 +138,7 @@ C Set up the time limit (caution! The time must be input in minutes!)
       call readi(controlcard,'MAXGEN',maxgen,10000)
       call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
       call readi(controlcard,"KDIAG",kdiag,0)
-      call readi(controlcard,"RESCALE_MODE",rescale_mode,1)
+      call readi(controlcard,"RESCALE_MODE",rescale_mode,2)
       if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0)
      & write (iout,*) "RESCALE_MODE",rescale_mode
       split_ene=index(controlcard,'SPLIT_ENE').gt.0
@@ -748,6 +749,12 @@ C 12/1/95 Added weight for the multi-body term WCORR
        call reada(weightcard,'WTORD',wtor_d,1.0D0)
        call reada(weightcard,'WANG',wang,1.0D0)
        call reada(weightcard,'WSCLOC',wscloc,1.0D0)
+C     Bartek
+       call reada(weightcard,'WDFAD',wdfa_dist,0.0d0)
+       call reada(weightcard,'WDFAT',wdfa_tor,0.0d0)
+       call reada(weightcard,'WDFAN',wdfa_nei,0.0d0)
+       call reada(weightcard,'WDFAB',wdfa_beta,0.0d0)
+C       
        call reada(weightcard,'SCAL14',scal14,0.4D0)
        call reada(weightcard,'SCALSCP',scalscp,1.0d0)
        call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
@@ -777,11 +784,18 @@ C 12/1/95 Added weight for the multi-body term WCORR
        weights(18)=scal14
        weights(21)=wsccor
       endif
+C     Bartek
+       weights(24)=wdfa_dist
+       weights(25)=wdfa_tor
+       weights(26)=wdfa_nei
+       weights(27)=wdfa_beta
 
       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,
-     &  wturn4,wturn6
+     &  wturn4,wturn6,
+     &  wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta
+
    10 format (/'Energy-term weights (unscaled):'//
      & 'WSCC=   ',f10.6,' (SC-SC)'/
      & 'WSCP=   ',f10.6,' (SC-p)'/
@@ -800,7 +814,12 @@ C 12/1/95 Added weight for the multi-body term WCORR
      & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/
      & 'WTURN3= ',f10.6,' (turns, 3rd order)'/
      & 'WTURN4= ',f10.6,' (turns, 4th order)'/
-     & 'WTURN6= ',f10.6,' (turns, 6th order)')
+     & 'WTURN6= ',f10.6,' (turns, 6th order)'/
+     & 'WDFA_D= ',f10.6,' (DFA, distance)'   /
+     & 'WDFA_T= ',f10.6,' (DFA, torsional)'   /
+     & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)'   /
+     & 'WDFA_B= ',f10.6,' (DFA, beta formation)')
+
       if(me.eq.king.or..not.out1file)then
        if (wcorr4.gt.0.0d0) then
         write (iout,'(/2a/)') 'Local-electrostatic type correlation ',
@@ -828,7 +847,9 @@ C 12/1/95 Added weight for the multi-body term WCORR
       if(me.eq.king.or..not.out1file)
      & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
      &  wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
-     &  wturn4,wturn6
+     &  wturn4,wturn6,
+     &  wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta
+
    22 format (/'Energy-term weights (scaled):'//
      & 'WSCC=   ',f10.6,' (SC-SC)'/
      & 'WSCP=   ',f10.6,' (SC-p)'/
@@ -847,7 +868,12 @@ C 12/1/95 Added weight for the multi-body term WCORR
      & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/
      & 'WTURN3= ',f10.6,' (turns, 3rd order)'/
      & 'WTURN4= ',f10.6,' (turns, 4th order)'/
-     & 'WTURN6= ',f10.6,' (turns, 6th order)')
+     & 'WTURN6= ',f10.6,' (turns, 6th order)'/
+     & 'WDFA_D= ',f10.6,' (DFA, distance)'   /
+     & 'WDFA_T= ',f10.6,' (DFA, torsional)'   /
+     & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)'   /
+     & 'WDFA_B= ',f10.6,' (DFA, beta formation)')
+
       if(me.eq.king.or..not.out1file)
      & write (iout,*) "Reference temperature for weights calculation:",
      &  temp0
@@ -1006,6 +1032,24 @@ C 8/13/98 Set limits to generating the dihedral angles
 cd      print *,'NNT=',NNT,' NCT=',NCT
       if (itype(1).eq.21) nnt=2
       if (itype(nres).eq.21) nct=nct-1
+
+C     Juyong:READ init_vars
+C     Initialize variables!
+C     Juyong:READ read_info
+C     READ fragment information!!
+C     both routines should be in dfa.F file!!
+
+      if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and.
+     &            wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then
+       call init_dfa_vars
+       print*, 'init_dfa_vars finished!'
+       call read_dfa_info
+       print*, 'read_dfa_info finished!'
+      endif
+C
+C
+
+
       if (pdbref) then
         if(me.eq.king.or..not.out1file)
      &   write (iout,'(a,i3)') 'nsup=',nsup
@@ -1075,11 +1119,6 @@ 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
-        call flush(iout)
-        if (constr_dist.gt.0) call read_dist_constr
-c        write (iout,*) "After read_dist_constr nhpb",nhpb
-        call hpb_partition
         if(me.eq.king.or..not.out1file)
      &   write (iout,*) 'Contact order:',co
         if (pdbref) then
@@ -1096,6 +1135,13 @@ c        write (iout,*) "After read_dist_constr nhpb",nhpb
         enddo
         endif
       endif
+c        write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
+      if (constr_dist.gt.0) then
+        call read_dist_constr
+        call hpb_partition
+      endif
+c      write (iout,*) "After read_dist_constr nhpb",nhpb
+c      call flush(iout)
       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
@@ -1810,6 +1856,9 @@ c----------------------------------------------------------------------------
       call readi(minimcard,'MINFUN',minfun,maxmin)
       call reada(minimcard,'TOLF',tolf,1.0D-2)
       call reada(minimcard,'RTOLF',rtolf,1.0D-4)
+      print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1)
+      print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1)
+      print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1)
       write (iout,'(/80(1h*)/20x,a/80(1h*))') 
      &         'Options in energy minimization:'
       write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)')
@@ -2192,6 +2241,7 @@ c      print *,"Processor",myrank," fg_rank",fg_rank
 #if defined(AIX) || defined(PGI)
       if (me.eq.king .or. .not. out1file) 
      &   open(iout,file=outname,status='unknown')
+c#define DEBUG
 #ifdef DEBUG
       if (fg_rank.gt.0) then
         write (liczba,'(i3.3)') myrank/nfgtasks
@@ -2200,6 +2250,7 @@ c      print *,"Processor",myrank," fg_rank",fg_rank
      &   status='unknown')
       endif
 #endif
+c#undef DEBUG
       if(me.eq.king) then
        open(igeom,file=intname,status='unknown',position='append')
        open(ipdb,file=pdbname,status='unknown')
@@ -2211,14 +2262,17 @@ c1out       open(iout,file=outname,status='unknown')
 #else
       if (me.eq.king .or. .not.out1file)
      &    open(iout,file=outname,status='unknown')
+c#define DEBUG
 #ifdef DEBUG
       if (fg_rank.gt.0) then
+        print "Processor",fg_rank," opening output file"
         write (liczba,'(i3.3)') myrank/nfgtasks
         write (ll,'(bz,i3.3)') fg_rank
         open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,
      &   status='unknown')
       endif
 #endif
+c#undef DEBUG
       if(me.eq.king) then
        open(igeom,file=intname,status='unknown',access='append')
        open(ipdb,file=pdbname,status='unknown')
@@ -2401,6 +2455,18 @@ c      write (iout,*) "IPAIR"
 c      do i=1,npair_
 c        write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
 c      enddo
+      if (.not.refstr .and. nfrag.gt.0) then
+        write (iout,*) 
+     &  "ERROR: no reference structure to compute distance restraints"
+        write (iout,*)
+     &  "Restraints must be specified explicitly (NDIST=number)"
+        stop 
+      endif
+      if (nfrag.lt.2 .and. npair.gt.0) then 
+        write (iout,*) "ERROR: Less than 2 fragments specified",
+     &   " but distance restraints between pairs requested"
+        stop 
+      endif 
       call flush(iout)
       do i=1,nfrag_
         if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
@@ -2475,21 +2541,29 @@ c        write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
         endif
       enddo 
       do i=1,ndist_
-        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1)
+        read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
+     &     ibecarb(i),forcon(nhpb+1)
         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
+      enddo
 #ifdef MPI
-          if (.not.out1file .or. me.eq.king)
-     &    write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
-     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
-          write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
-     &     nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
+      if (.not.out1file .or. me.eq.king) then
 #endif
-        endif
+      do i=1,nhpb
+          write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ",
+     &     i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i)
       enddo
       call flush(iout)
+#ifdef MPI
+      endif
+#endif
       return
       end
 c-------------------------------------------------------------------------------