subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,
     * nshear,jpltcd)
c* * * * * *
c
c     select a variable contour plotting (user subroutine).
c
c     v            variable
c     s (idss)         stress array
c     sp           stresses in preferred direction
c     etot          total strain (generalized)
c     eplas         total plastic strain
c     ecreep        total creep strain
c     t             current temperature
c     m            element number
c     nn           integration point number
c     layer        layer number
c     ndi (3)       number of direct stress components
c     nshear (3)    number of shear stress components
c
c* * * * * *
      implicit real*8 (a-h,o-z)                                               dp
      dimension s(1),etot(1),eplas(1),ecreep(1),sp(1)
      common /mydata/ conn(6,400),coord(2,459)
      include '../common/concom'
      dimension stress(3,3),tract(3,3),g(3,3)
      dimension dis1(2),dis2(2)
c ***  determine 1-2 deformed edge orientation of elment m
c ***  only for first call of plot codes
      if(jpltcd.eq.11)  then 
         n1=conn(3,m)
         n2=conn(4,m)
         call getdis(n1,dis1)
         x1=coord(1,n1)+dis1(1)
         y1=coord(2,n1)+dis1(2)
         call getdis(n2,dis2)
         x2=coord(1,n2)+dis2(1)
         y2=coord(2,n2)+dis2(2)
         d = dsqrt((x2-x1)**2+(y2-y1)**2)
         do 1 k=1,3
            do 1 l=1,3
              g(k,l)=0.0d0
              stress(k,l)=0.0d0
              tract(k,l)=0.0d0
1        continue
         stress(1,1)=s(1)
         stress(2,2)=s(2)
         stress(3,3)=s(3)
         stress(1,2)=s(4)
         stress(1,3)=0.0d0
         stress(2,3)=0.0d0
         stress(3,1)=stress(1,3)
         stress(2,1)=stress(1,2)
         stress(3,2)=stress(2,3)
         g(1,1)=(x2-x1)/d
         g(1,2)=(y2-y1)/d
         g(2,2)=(x2-x1)/d
         g(2,1)=-g(1,2)
         g(3,3)=1.0d0
      end if
c***** select stress components
      if(jpltcd.eq.11)  then 
        i=1
        j=1
      else if(jpltcd.eq.12)  then 
        i=2
        j=2
      else if(jpltcd.eq.13)  then 
        i=3
        j=3
      else if(jpltcd.eq.14)  then 
        i=1
        j=2
      end if 
c***** transform stress components
      do 20 l=1,3
         do 20 k=1,3
            tract(i,j)=tract(i,j)+g(i,k)*g(j,l)*stress(k,l)
20    continue
c***** print on last plot code for selected elements
      if(jpltcd.eq.14)  then 
      if(m.eq.64.or.m.eq.68) write(6,100) m
     + ,n1,coord(1,n1),coord(2,n1),dis1(1),dis1(2)
     + ,n2,coord(1,n2),coord(2,n2),dis2(1),dis2(2)
     + ,g(1,1),g(1,2)
     + ,stress(1,1),stress(1,2),stress(1,3)
     + ,stress(2,1),stress(2,2),stress(2,3)
     + ,stress(3,1),stress(3,2),stress(3,3)
     + ,tract(1,1),tract(1,2),tract(1,3)
     + ,tract(2,1),tract(2,2),tract(2,3)
     + ,tract(3,1),tract(3,2),tract(3,3)
100   format(' element',i5
     + ,/,' node1',i5,4(1pe10.3) 
     + ,/,' node2',i5,4(1pe10.3) 
     + ,/,' g(1,1),g(1,2)',2(1pe10.3) 
     + ,/,' stress=',3(1pe10.3)
     + ,/,' stress=',3(1pe10.3)
     + ,/,' stress=',3(1pe10.3)
     + ,/,' tract=',3(1pe10.3)
     + ,/,' tract=',3(1pe10.3)
     + ,/,' tract=',3(1pe10.3) )
      end if       
      if(m.eq.400.and.jpltcd.eq.11) then
         theta=2.0d0*(90.0d0-dacos(g(1,1))*180.0d0/3.14159d0)
         write(6,200) inc, theta
200      format(' inc, theta=',i5,1pe10.3)
      end if
c***** return with selected traction
      v=tract(i,j)
      if(jpltcd.eq.15) v=theta
      return
      end
      subroutine ufconn(j,itype,lm,nnodmx)
c******
c     user routine for changing element connectivity
c     j       element number
c     itype   element type
c     lm      connectivity
c     nnodmx  maximun number of nodes per element
      implicit real*8 (a-h,o-z)                                               dp
      common /mydata/ conn(6,400),xord(2,459)
      dimension lm(1)
      conn(1,j)=j
      conn(2,j)=itype
      do 1 i =3,6
         conn(i,j)=lm(i-2)
1     continue
c     write(6,100) j,itype,(lm(i),i=1,4),nnodmx
100   format(' j,itype,(lm(i),i=1,4),nnodmx=',7i5)
      return
      end
      subroutine ufxord(xord,ncrd,n)
      implicit real*8 (a-h,o-z)                                               dp
c* * * * * *
c
c     user subroutine to enter or modify nodal coordinates.
c
c     used here to add a surface imperfection to 
c     the upper edge of the specimen
c
c* * * * * *
      dimension xord(ncrd)
      common /mydata/ conn(6,400),coord(2,459)
      do 1 i=1,2
         coord(i,n)=xord(i)
1     continue
c     write(6,100) n,(xord(i),i=1,2)
100   format(' n,(xord(i),i=1,2)=',i5,2(1pe10.3))
c
      return
      end
      subroutine getdis(lext,dis)
      implicit real*8 (a-h,o-z)                                               dp
      include '../common/dimen'
      include '../common/develp'
      include '../common/array2'
      include '../common/arrays'
      include '../common/space'
      dimension ddnode(12),ccnode(12),dis(2)
c**** get internal node number for lext
      lint=ibsrch(lext,ints(inoids),numnp,1)
      la2= inpnum+lint-1
      if(joptit.ne.0) lint=igetsh(ints(la2),0)
      jrdpre = 0
c**** get coordinates for node lint, not used
      call vecftc(ccnode,vars(ixord),ncrdmx,ncrd,lint,jrdpre,2,1)
      jrdpre = 0
c**** get displacements for node lint
      call vecftc(ddnode,vars(idsxt),ndegmx,ndeg,lint,jrdpre,2,5)
      dis(1)=ddnode(1)
      dis(2)=ddnode(2)
c     write(6,100) lext,lint,(ddnode(i),i=1,12)
100   format(' lext,lint,(ddnode(i),i=1,12)',2i5,/,12(1pe10.3))
      return
      end