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

[unres.git] / source / unres / src_MD-NEWSC / map.f

diff --git a/source/unres/src_MD-NEWSC/map.f b/source/unres/src_MD-NEWSC/map.f
new file mode 100644 (file)
index 0000000..9dbe64e
--- /dev/null
+++ b/source/unres/src_MD-NEWSC/map.f
@@ -0,0 +1,90 @@
+      subroutine map
+      implicit real*8 (a-h,o-z)
+      include 'DIMENSIONS'
+      include 'COMMON.MAP'
+      include 'COMMON.VAR'
+      include 'COMMON.GEO'
+      include 'COMMON.DERIV'
+      include 'COMMON.IOUNITS'
+      include 'COMMON.NAMES'
+      include 'COMMON.CONTROL'
+      include 'COMMON.TORCNSTR'
+      double precision energia(0:n_ene)
+      character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/
+      double precision ang_list(10)
+      double precision g(maxvar),x(maxvar)
+      integer nn(10)
+      write (iout,'(a,i3,a)')'Energy map constructed in the following ',
+     &       nmap,' groups of variables:'
+      do i=1,nmap
+        write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ',
+     &   res1(i),' to ',res2(i)
+      enddo
+      nmax=nstep(1)
+      do i=2,nmap
+        if (nmax.lt.nstep(i)) nmax=nstep(i)
+      enddo
+      ntot=nmax**nmap
+      iii=0
+      write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap),
+     &    (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM"
+      do i=0,ntot-1
+        ii=i
+        do j=1,nmap
+          nn(j)=mod(ii,nmax)+1
+          ii=ii/nmax
+        enddo
+        do j=1,nmap
+          if (nn(j).gt.nstep(j)) goto 10
+        enddo
+        iii=iii+1
+Cd      write (iout,*) i,iii,(nn(j),j=1,nmap)
+        do j=1,nmap
+          ang_list(j)=ang_from(j)
+     &       +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j)
+          do k=res1(j),res2(j)
+            goto (1,2,3,4), kang(j)
+    1       phi(k)=deg2rad*ang_list(j)
+            if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j)
+            goto 5
+    2       theta(k)=deg2rad*ang_list(j)
+            goto 5
+    3       alph(k)=deg2rad*ang_list(j)
+            goto 5
+    4       omeg(k)=deg2rad*ang_list(j)
+    5       continue
+          enddo ! k
+        enddo ! j
+        call chainbuild
+        call int_from_cart1(.false.)
+        if (minim) then 
+         call geom_to_var(nvar,x)
+         call minimize(etot,x,iretcode,nfun)
+         print *,'SUMSL return code is',iretcode,' eval ',nfun
+c         call intout
+        else
+         call zerograd
+         call geom_to_var(nvar,x)
+        endif
+         call etotal(energia(0))
+         etot = energia(0)
+         nf=1
+         nfl=3
+         call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
+         gnorm=0.0d0
+         do k=1,nvar
+           gnorm=gnorm+g(k)**2
+         enddo
+        etot=energia(0)
+
+        gnorm=dsqrt(gnorm)
+c        write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm
+        write (istat,'(30e15.5)') (ang_list(k),k=1,nmap),
+     &   (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm
+c        write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap)
+c        call intout
+c        call enerprint(energia)
+   10   continue
+      enddo ! i
+      return
+      end