Merge branch 'lipid' of mmka.chem.univ.gda.pl:unres into lipid

[unres.git] / source / unres / src_MD-M-newcorr / regularize.F

diff --git a/source/unres/src_MD-M-newcorr/regularize.F b/source/unres/src_MD-M-newcorr/regularize.F
new file mode 100644 (file)
index 0000000..c506b8a
--- /dev/null
+++ b/source/unres/src_MD-M-newcorr/regularize.F
@@ -0,0 +1,76 @@
+      subroutine regularize(ncart,etot,rms,cref0,iretcode)
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.SBRIDGE'
+      include 'COMMON.CHAIN'
+      include 'COMMON.INTERACT'
+      include 'COMMON.HEADER'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.MINIM'
+      double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar)
+      double precision cref0(3,ncart)
+      double precision energia(0:n_ene)
+      logical non_conv
+      link_end0=link_end
+      do i=1,nhpb
+        fhpb0(i)=forcon(i)
+      enddo
+      maxit_reg=2
+      print *,'Enter REGULARIZE: nnt=',nnt,' nct=',nct,' nsup=',nsup,
+     & ' nstart_seq=',nstart_seq,' nstart_sup',nstart_sup
+      write (iout,'(/a/)') 'Initial energies:'
+      call geom_to_var(nvar,varia)
+      call chainbuild
+      call etotal(energia(0))
+      etot=energia(0)
+      call enerprint(energia(0))
+      call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),
+     &  nsup,przes,obrot,non_conv)
+      write (iout,'(a,f10.5)') 
+     & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms))
+      write (*,'(a,f10.5)') 
+     & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms))
+      maxit0=maxit
+      maxfun0=maxfun
+      rtolf0=rtolf
+      maxit=100
+      maxfun=200
+      rtolf=1.0D-2
+      do it=1,maxit_reg
+        print *,'Regularization: pass:',it
+C Minimize with distance constraints, gradually relieving the weight.
+        call minimize(etot,varia,iretcode,nfun)
+        print *,'Etot=',Etot
+        if (iretcode.eq.11) return
+        call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),
+     &   nsup,przes,obrot,non_conv)
+        rms=dsqrt(rms)
+        write (iout,'(a,i2,a,f10.5,a,1pe14.5,a,i3/)') 
+     &   'Finish pass',it,', RMS deviation:',rms,', energy',etot,
+     &   ' SUMSL convergence',iretcode
+        do i=nss+1,nhpb
+          forcon(i)=0.1D0*forcon(i)
+        enddo
+      enddo
+C Turn off the distance constraints and re-minimize energy.
+      print *,'Final minimization ... '
+      maxit=maxit0
+      maxfun=maxfun0
+      rtolf=rtolf0
+      link_end=min0(link_end,nss)
+      call minimize(etot,varia,iretcode,nfun)
+      print *,'Etot=',Etot
+      call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),nsup,
+     &  przes,obrot,non_conv)
+      rms=dsqrt(rms)
+      write (iout,'(a,f10.5,a,1pe14.5,a,i3/)') 
+     & 'Final RMS deviation:',rms,' energy',etot,' SUMSL convergence',
+     & iretcode
+      link_end=link_end0
+      do i=nss+1,nhpb
+        forcon(i)=fhpb0(i)
+      enddo
+      call var_to_geom(nvar,varia)
+      call chainbuild
+      return
+      end