source/unres/src-HCD-5D/map.F

   1       subroutine map
   2       implicit none
   3       include 'DIMENSIONS'
   4       include 'COMMON.MAP'
   5       include 'COMMON.VAR'
   6       include 'COMMON.GEO'
   7       include 'COMMON.DERIV'
   8       include 'COMMON.IOUNITS'
   9       include 'COMMON.NAMES'
  10       include 'COMMON.CONTROL'
  11       include 'COMMON.TORCNSTR'
  12       double precision energia(0:n_ene)
  13       character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/
  14       double precision ang_list(10)
  15       double precision g(maxvar),x(maxvar),gnorm,etot
  16       integer i,ii,iii,j,k,nf,nfun,iretcode,nmax,ntot
  17       integer uiparm(1)
  18       double precision urparm(1),fdum
  19       external fdum
  20       double precision funcgrad,ff
  21       external funcgrad
  22       integer nn(10)
  23       write (iout,'(a,i3,a)')'Energy map constructed in the following ',
  24      &       nmap,' groups of variables:'
  25       do i=1,nmap
  26         write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ',
  27      &   res1(i),' to ',res2(i)
  28       enddo
  29       nmax=nstep(1)
  30       do i=2,nmap
  31         if (nmax.lt.nstep(i)) nmax=nstep(i)
  32       enddo
  33       ntot=nmax**nmap
  34       iii=0
  35       write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap),
  36      &    (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM"
  37       do i=0,ntot-1
  38         ii=i
  39         do j=1,nmap
  40           nn(j)=mod(ii,nmax)+1
  41           ii=ii/nmax
  42         enddo
  43         do j=1,nmap
  44           if (nn(j).gt.nstep(j)) goto 10
  45         enddo
  46         iii=iii+1
  47 Cd      write (iout,*) i,iii,(nn(j),j=1,nmap)
  48         do j=1,nmap
  49           ang_list(j)=ang_from(j)
  50      &       +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j)
  51           do k=res1(j),res2(j)
  52             goto (1,2,3,4), kang(j)
  53     1       phi(k)=deg2rad*ang_list(j)
  54             if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j)
  55             goto 5
  56     2       theta(k)=deg2rad*ang_list(j)
  57             goto 5
  58     3       alph(k)=deg2rad*ang_list(j)
  59             goto 5
  60     4       omeg(k)=deg2rad*ang_list(j)
  61     5       continue
  62           enddo ! k
  63         enddo ! j
  64         call chainbuild
  65         if (minim) then
  66          call geom_to_var(nvar,x)
  67          call minimize(etot,x,iretcode,nfun)
  68          print *,'SUMSL return code is',iretcode,' eval ',nfun
  69 c         call intout
  70         else
  71          call zerograd
  72          call geom_to_var(nvar,x)
  73         endif
  74          call etotal(energia(0))
  75          etot = energia(0)
  76          nf=1
  77          nfl=3
  78 #ifdef LBFGS
  79          ff=funcgrad(x,g)
  80 #else
  81          call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
  82 #endif
  83          gnorm=0.0d0
  84          do k=1,nvar
  85            gnorm=gnorm+g(k)**2
  86          enddo
  87         etot=energia(0)
  88
  89         gnorm=dsqrt(gnorm)
  90 c        write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm
  91         write (istat,'(30e15.5)') (ang_list(k),k=1,nmap),
  92      &   (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm
  93 c        write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap)
  94 c        call intout
  95 c        call enerprint(energia)
  96    10   continue
  97       enddo ! i
  98       return
  99       end