wham and cluster_wham Adam's new constr_dist multichain
[unres.git] / source / unres / src_MD-M / map.f
1       subroutine map
2       implicit real*8 (a-h,o-z)
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       include 'COMMON.HEADER'
13       double precision energia(0:n_ene)
14       character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/
15       double precision ang_list(10)
16       double precision g(maxvar),x(maxvar)
17       integer nn(10)
18       write (iout,'(a,i3,a)')'Energy map constructed in the following ',
19      &       nmap,' groups of variables:'
20       do i=1,nmap
21         write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ',
22      &   res1(i),' to ',res2(i)
23       enddo
24       write (iout,*) "outpdb",outpdb
25       nmax=nstep(1)
26       do i=2,nmap
27         if (nmax.lt.nstep(i)) nmax=nstep(i)
28       enddo
29       ntot=nmax**nmap
30       iii=0
31       write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap),
32      &    (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM"
33       do i=0,ntot-1
34         ii=i
35         do j=1,nmap
36           nn(j)=mod(ii,nmax)+1
37           ii=ii/nmax
38         enddo
39         do j=1,nmap
40           if (nn(j).gt.nstep(j)) goto 10
41         enddo
42         iii=iii+1
43 Cd      write (iout,*) i,iii,(nn(j),j=1,nmap)
44         do j=1,nmap
45           ang_list(j)=ang_from(j)
46      &       +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j)
47           do k=res1(j),res2(j)
48             goto (1,2,3,4), kang(j)
49     1       phi(k)=deg2rad*ang_list(j)
50             if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j)
51             goto 5
52     2       theta(k)=deg2rad*ang_list(j)
53             goto 5
54     3       alph(k)=deg2rad*ang_list(j)
55             goto 5
56     4       omeg(k)=deg2rad*ang_list(j)
57     5       continue
58           enddo ! k
59         enddo ! j
60         call chainbuild_extconf
61         if (minim) then 
62          call geom_to_var(nvar,x)
63          call minimize(etot,x,iretcode,nfun)
64          print *,'SUMSL return code is',iretcode,' eval ',nfun
65 c         call intout
66         else
67          call zerograd
68          call geom_to_var(nvar,x)
69         endif
70          call etotal(energia(0))
71          etot = energia(0)
72          nf=1
73          nfl=3
74          call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
75          gnorm=0.0d0
76          do k=1,nvar
77            gnorm=gnorm+g(k)**2
78          enddo
79         etot=energia(0)
80
81         gnorm=dsqrt(gnorm)
82 c        write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm
83         write (istat,'(30e15.5)') (ang_list(k),k=1,nmap),
84      &   (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm
85         if (outpdb) call pdbout(etot,titel(:50),ipdb)
86 c        write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap)
87 c        call intout
88 c        call enerprint(energia)
89    10   continue
90       enddo ! i
91       return
92       end