subroutine dynamic
	implicit real*8 (a-h,o-z)
	common /mvt/u(5,4)
	include 'analc.inc'
	include 'tempstor.inc'
	include 'input.inc'
	include 'const.inc'
	dimension idelta(6,6),di(6,27),tri1(6,6,0:6),tri2(6,6,0:6)
	dimension tris(6,6,0:6),tpr(6,6,0:6)
	character*3 ans
	dimension x(6),y(6)
	dimension dnu(2,6),dbeta(2,6)
	common /opname/noptype(4)
	data idelta/1,6*0,1,6*0,1,6*0,1,6*0,1,6*0,1/
	data idum/0/
	nopr=0
	if(noptype(1).eq.'S')nopr=1
c  fill array u(5,4) for coupling analysis
	do 301 i=1,4
	do 301 j=1,4
301	u(i+1,j)=temp(j,i)
	call decmvtmat(idum,1,1)
c  convert temp(6X27) to tri1(6X6X6)
	do 30 i=1,6
	do 30 j=1,27
30	di(i,j)=temp(i,j)
	call two2thre(temp,tri1)
c  calculate ampliticity
	if(nopr.eq.0)write(iout,9)
9	format(/,' Ampliticity ')
	do l=1,2
	  if(l.eq.1.and.nopr.eq.0)write(iout,11)
	  if(l.eq.2.and.nopr.eq.0)write(iout,12)
11	format(/,' change in horizontal tune with x(j) ')
12	format(/,' change in vertical tune with x(j) ')
	  k=2*l-2
	  cosk=.5*(tri1(1+k,1+k,0)+tri1(2+k,2+k,0))
	if(abs(cosk).gt.1.d0)then
	  cosk=0.d0
	  write(iout,111)
111	format(' unstable in dynamic ')
	  endif
	  sink=dsqrt(1.d0-cosk*cosk)
	  do j=1,6
	    dnu(l,j)=-1/(2*pi)/sink*
     &	      (tri1(1+k,1+k,j)+tri1(1+k,j,1+k)+
     &	      tri1(2+k,2+k,j)+tri1(2+k,j,2+k))
	    if(nopr.eq.0)write(iout, 8)j,dnu(l,j)
8	    format(' j,dnu(l,j) ',i5,e10.3)
	    dbeta(l,j)=1/(2*pi)/sink*
     &	       (tri1(1+k,2+k,j)+tri1(1+k,j,2+k))
	    if(nopr.eq.0)write(iout,88)j,dbeta(l,j)
88	    format(' j,dbeta(l,j) ',i5,e10.3)
	    end do
	  end do
	if(noptype(1).eq.'S'.and.noptype(2).eq.'I')then
	p39(1)=dnu(1,1)
	p39(3)=dnu(1,2)
	p39(4)=dnu(2,1)
	p39(5)=dnu(2,2)
c  transfer through pretzel
	call two2thre(temp1,tpr)
c	p39(3)=tpr(1,2,0)
c	return
	p39(6)=tpr(1,1,2)
	p39(7)=tpr(1,2,2)
	p39(7)=tri1(3,1,0)+tri1(2,4,0)
	p39(8)=tri1(3,2,0)-tri1(1,4,0)
	p39(9)=tri1(4,1,0)-tri1(2,3,0)
	p39(10)=tpr(2,1,2)
	p39(11)=tpr(2,2,2)
	p39(13)=tpr(2,2,6)
	p39(14)=tpr(3,2,3)
	p39(15)=tpr(3,2,4)
	p39(16)=tpr(2,4,4)
	p39(17)=tpr(4,2,3)
	p39(19)=tpr(4,2,4)
	p39(20)=tpr(4,1,3)
	endif
	if(noptype(1).ne.'M'.or.noptype(2).ne.'A'.or.noptype(3).ne.'T'.
     &	  or.noptype(4).ne.'R')return
c  square second order full turn transfer matrix N times. The
c  equivalent number of turns is NTURNS= 2**N.
90	nturns=1
	do 110 i=1,6
	do 110 j=1,6
	do 110 k=0,6
110	tris(i,j,k)=tri1(i,j,k)
	type 71
71	format(' How many times do you want to square full turn ? ',$)
	accept *,n
	do i=1,n
	  nturns=nturns*2
	  call trimult(tri2,tris,tris)
	  do 10 j=1,6
	    do 10 k=1,6
	      do 10 l=0,6
10	    tris(j,k,l)=tri2(j,k,l)
	  end do
	write(iout,1)nturns
1	format(' Second order transfer matrix calculated for ',i5,' turns.')
c  Map x0 through nturn turns to xfinal
	type 3
3	format(' Do you want to map some points ? ',$)
	accept 4,ans
4	format(a)
	if(ans(1:1).eq.'y'.or.ans(1:1).eq.'Y')then
20	  type 2
2	  format(' Type x( 1-6) ',$)  
	  accept *,x
    	  call vecmult(y,tris,x)
	  write(iout,5)
5	  format(' X at origin ')
	  write(iout,91)x
91	  format(5x,6e10.3)
	  write(iout,6)nturns
6	  format(' X after ',i5,' turns    ')
	  write(iout,92)y
92	  format(5x,6e10.3)
	  type 7
7	  format(' Try another point ? ',$)
	  accept 4,ans
	  if(ans(1:1).eq.'y'.or.ans(1:1).eq.'Y')goto 20
	  endif
	type 72
72	format(' Calculate a different number of turns ? ',$)
	accept 4,ans
	if(ans(1:1).eq.'y'.or.ans(1:1).eq.'Y')goto 90
	return
	end