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 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