subroutine uinstr(s,ndi,nshear,m,nn,kc,xintp,ncrd,inc,cptim,
     1                  timinc)
      implicit real*8(a-h,o-z)                                               dp
      dimension s(1),xintp(1),m(2)
c
c    *******************************
c    s      stress vector
c    ndi    number of stress components
c    nshear number of shear stress components
c    m(1)   user element number
c    m(2)   internal element number
c    nn     interation point number
c    kc     layer number (shells or beams only)
c    xintp  array of int point coordinates
c    ncrd   number of coordinates
c    inc    increment number
c    time   total time at begin of incre
c    timeinc incremental time
c    *******************************
c* * * * * *
C     call  pstfr (mtype,sarray,melem,intpt)
C  mtype = 1 for stress
c  sarray (component) = array of stresses
c  melem is element number
c  intpt is int point number
c* * * * * *
c     write(6,501)
501    format (' subroutine uinstr called ')
c     write(42,601) me,s
      me = m(1)
      call pstfr (1,s,me,nn)
c     write(42,601) me,nn,(s(k),k=1,6)
601   format(' unistr sub,element no,int pt,stresses ',2i5,/,6e10.3)
      return
      end
      subroutine initpl(sv,layers,intpts,m)
      implicit real*8 (a-h,o-z)                                               dp
      dimension sv(layers,intpts)
      dimension sarray(10000)
c* * * * * *
c
c     user subroutine to input initial values of equivalent plastic
c     strain
c
c     sv           state variable array
c     layers       number of layers per integration point
c     intpts       number of integration points in the elements
c     m            element number
c     id           1
c
c* * * * * *
C     call  pstfr (mtype,sarray,melem,intpt)
C  mtype = 2 for strain
c  sarray (intptno) is equiv pl strains from post file
c  melem is element number
c  intpt is int point number, not used for strains
c* * * * * *
c     write(6,501)
501    format (' subroutine initpl called ')
c     write(42,601) m,sarray
      call pstfr (2,sarray,m,1)
      do 100 k = 1, intpts
      sv(1,k) = sarray(k)
100    continue
c     write(42,601) m,(sarray(k),k=1,intpts)
601   format(' initpl sub, element no, strains ',i7,4e10.3)
      return
      end
      subroutine pstfr (mtype,sarray,melem,intpt)
      implicit real*8(a-h,o-z)
      include '../common/dimen'
C
c ******************************************
C   mtype  =1 for stress
C   mtype  =2 for strain
c   sarray is the stress or strain array
c     for stress it is the the 6 components
c     for strain it is the equiv pls strain at each intpt
c   melem is the element number for input
c   intpt is only used for stress and is int point
c ******************************************
c
c    the dimen common may cause  name conflicts
c
      common /mydata/ stress,ttrain,epstrn
      dimension stress(4,6,9000) 
      dimension ttrain(4,6,9000)
      dimension epstrn(4,6,9000)
c     dimension stress(4,6,10000) 
      dimension sarray(12)
      dimension strain(12,10000)
      dimension jelem(10000)
      dimension adum(100),idum(3600),title(70),jdum(100)
      dimension nsett(12),nitem(6),nndum(5000),set(12)
      equivalence (nitem(1),nsett(7))
c     dimension ifile(8),form(80) 
      character*80 form
      character*80 ifile
c ******************************************
c      numnp = 124
c      numel = 97
c ******************************************
C $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C  File Form has the form of 
C	number of post file   I5 format
C	type of post file     binary/format
C	increment number for 
C           prestress state   I5 format
C   	name of post file     alpha format
C   REPEAT last 3 lines for each post file
C $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
c     write(6,501)
501    format (' subroutine pstfr called ')
      if (icall.eq.1) go to 1951
C   This will open an read the input file for the restart
      open(unit=42, status='unknown',file='myout')
      open(unit=41, status='unknown',file='form')
      read(41,403) ipost
      write(42,403) ipost
      icall = 1
301   format(a6)
401   format(1a80,/,i5,/,1a80)
403   format(i5)
101   format(70a1)
107   format(' starting block number ',i5)
21    format(6i13)
31    format(1i13)
51    format(1i13,5e13.6,:/(6e13.6))
61    format(5i13)
81    format(6e13.6/3e13.6)
91    format(12a1)
92    format(2i13)
102   format(1a4)
111   format(6i13)
121   format(6e13.6)
331   format(' invalid file format chosen ')
9999  format(' error in reading post file,  block number ',i5)
CCCCC  31    format(1i13,24a1)
49    format('  The number of nodes or elements do not match, 
     *    Bad post file ')
241   format('  The post file does not contain 
     *stress and/or strain data ')
      do 1950 itot = 1, ipost
      read(41,401) form,numinc,ifile
      write(42,401) form,numinc,ifile
      mtstress = 0
      mtstrain = 0
      mtttrain = 0
      mteplast = 0
      if (form.eq.'binary') rdform=1
      if (form.eq.'format') rdform=2
c     write (42,106) rdform
c     if (numinc.lt.1) numinc = 1
      if (rdform.eq.1) infile = 17
      if (rdform.eq.2) infile = 20
      ibck = -1
      write (42,107) ibck
c     write (42,106) infile
106   format(' file format info ',i5)
      if(rdform.eq.1)  then
      open(infile,access='sequential',status='old', 
     *err=321,form='unformatted',file=ifile)
      else
        if(rdform.eq.2)  then 
        open(infile,access='sequential',status='old', 
     *err=321,form='formatted',file=ifile)
        else
           write(6,331)
        endif
      endif
c The rdform sets the post file for the binary or formated
c then it rewinds the file 
c then ir reads the title from the first record
      ibck = 0
      write (42,107) ibck
      if(rdform.eq.1) call seqmt(infile,rewind,1,-2)
      if(rdform.eq.2) rewind infile
      if (rdform.eq.1) call seqmt(infile,title,70,0)
c     if (rdform.eq.2) read(infile,101,end=9900) (title(i),i=1,4)
      if (rdform.eq.2) read(infile,101,end=9900) (title(i),i=1,70)
5     continue
C  This will read block 2, which is analysis information
      ibck = ibck + 1
      write (42,107) ibck
      if (rdform.eq.1) call seqmt(infile,idum,18,0)
      if (rdform.eq.2) read(infile,21,end=9900) (idum(i),i=1,18)
      inum   = idum(1)
      lnum   = idum(2)
      mnum   = idum(3)
      ndegr  = idum(4)
c     changed ndeg to ndegr so no conflict in name
      nstres = idum(5)
      inod   = idum(6)
      ipstcc = idum(7)
      nadtie = idum(8)
      ncrdr  = idum(9)
c     changed ncrd to ncrdr so no conflict in name
      nnomax = idum(10)
c     changed nnodmx to nnomax so no conflict in name
      iantyp = idum(11)
      icompl = idum(12)
      nbctra = idum(13)
      ipostr = idum(14)
      ndistl = idum(15)
      nset   = idum(16)
      nsprng = idum(17)
      ndie   = idum(18)
c this checks to see if the number of node and elements match
C     if ((lnum.le.numnp).or.(mnum.le.numel)) go to 149
C  This will read block 2a, which is set information
      ibck = ibck + 1
      write (42,107) ibck
      if (rdform.eq.1) call seqmt(infile,nsett,12,0)
      if (rdform.eq.2) read(infile,21,end=9900) (nsett(k),k=1,12)
C if inum is 0 then there is no stress or strain data on post file
C   need to stop and get correct post file
      if ((inum.eq.0).and.(inc.eq.0)) go to 141 
      if (inum.eq.0)  go to 41 
C inum is the number of ploting codes and the following loop 
C   reads the post codes
C   This will read block 3 post codes
      ibck = ibck + 1
      write (42,107) ibck
      do 32 k = 1,inum
      if (rdform.eq.1) call seqmt(infile,jdum(1),1,0)
      if (rdform.eq.2) read(infile,31,end=9900) jdum(1)
      if ((jdum(1).eq.7).or.(jdum(1).eq.27)) mtstrain = k
      if (jdum(1).eq.311) mtstress = k
      if (jdum(1).eq.301) mtttrain = k
      if (jdum(1).eq.321) mteplast = k
32    continue
41    continue
      if (ipstcc.eq.0) go to 45
C   This will read block 4 element connectivities
      ibck = ibck + 1
      write (42,107) ibck
      nr = nnomax +3
C mnum is number of elements in the mesh
      if (mnum.eq.0) go to 44
      do 43 ne = 1,mnum
      if (rdform.eq.1) call seqmt(infile,jdum,nr,0)
      if (rdform.eq.2) read(infile,21,end=9900) (jdum(k),k=1,nr)
      jelem(ne) = jdum (1)
      nt = jdum(3) + 3
43    continue
44    continue
C  This will read block 5 - nodal coordinates
      ibck = ibck + 1
      write (42,107) ibck
      ncrd1 = ncrdr + 1
      do 46 nn = 1,lnum
      if (rdform.eq.1) call seqty(infile,adum,ncrd1,0)
      if (rdform.eq.2) read(infile,51,end=9900) (adum(k),k=1,ncrd1)
46    continue
45    continue
c  This will read block 6 - spring data
      ibck = ibck + 1
      write (42,107) ibck
      if(nsprng.eq.0) go to 70
c     write (42,108) nsprng
108   format (' number of springs = ')
      do 71 i=1,nsprng
      if (rdform.eq.1) call seqmt(infile,idum,5,0)
      if (rdform.eq.2) read(infile,61,end=9900) (idum(k),k=1,5)
71    continue
70    continue
c block 7 This will read nodal codes and transformations
      ibck = ibck + 1
      write (42,107) ibck
      if (rdform.eq.1) call seqmt(infile,nndum,lnum,0)
      if (rdform.eq.2) read(infile,21,end=9900) (nndum(k),k=1,lnum)
      ibck = ibck + 1
      write (42,107) ibck
      if (nadtie.eq.0) go to 63
c  This will read block 8 - ties for adaptive meshing
      do 60 nt=1,nadtie
c     write (42,109) nadtie
109   format (' number of ties = ')
      if (rdform.eq.1) call seqmt(infile,idum,2,0)
      if (rdform.eq.2) read(infile,92,end=9900) (idum(k),k=1,2)
c     write (42,107) idum(2)
      if (rdform.eq.1) call seqmt(infile,nndum,idum(2),0)
      if (rdform.eq.2) read(infile,21,end=9900) (nndum(k),k=1,idum(2))
60    continue
63    continue
      ibck = ibck + 1
      write (42,107) ibck
      if(ipstcc.eq.0) go to 151
      if(nbctra.eq.0) go to 151
c  read in direction cosines of transformation matrix from local to 
c   gobal sytem   Block 9
      write (42,107) ibck
      do 47 nt =1,nbctra
      if (rdform.eq.1) call seqty(infile,adum,9,0)
      if (rdform.eq.2) read(infile,81,end=9900) (adum(k),k=1,9)
47    continue
151   continue
c     write(42,110)
110    format(' statement 151 ')
c block 10  set definition 
      ibck = ibck + 1
      write (42,107) ibck
c     write (42,107) nset
      if (nset.eq.0) go to 58
      do 57 ns =1,nset
      if (rdform.eq.1) call seqty(infile,set,12,0)
      if (rdform.eq.2) read(infile,91,end=9900) (set(k),k=1,12)
      if (rdform.eq.1) call seqmt(infile,idum,2,0)
      if (rdform.eq.2) read(infile,92,end=9900) (idum(k),k=1,2)
      itt=idum(1)
c     write(42,127) ns
127   format (' reading set number ',i5)
      if (rdform.eq.1) call seqmt(infile,idum,itt,0)
      if (rdform.eq.2) read(infile,21,end=9900) (idum(k),k=1,itt)
57    continue
58    continue
c     write(42,113)
113    format(' statement 58 ')
c    **********************
c loop on increment numbers 
c block 11 - begin of increment indicator
      ibck = ibck + 1
      write (42,107) ibck
      numlst = numinc + 1
      do 80 ll = 1,numlst
      write (42,137) numinc,ll,inc
137   format(' total number of increments ',i5,
     */,' starting increment number ',i5
     */,' current increment number ',i5)
      ibck = 11
      write (42,107) ibck
c  read increment indicator
      if (rdform.eq.1) call seqmt(infile,isee,1,0)
      if (rdform.eq.2) read(infile,102,end=9900) isee
c     write(42,102) isee
c  block 12 - integer increment verification data
      ibck = ibck + 1
      write (42,107) ibck
      if (rdform.eq.1) call seqmt(infile,idum,6,0)
      if (rdform.eq.2) read(infile,111,end=9900) (idum(k),k=1,6)
c     write(42,111) (idum(k),k=1,6)
      inc = idum(2)
      newcc =  idum(1)
      incsub =  idum(3)
      irezon =  idum(4)
      knod =  idum(5)
c block 13 - real increment verification data
      ibck = ibck + 1
      write (42,107) ibck
      if (rdform.eq.1) call seqty(infile,adum,6,0)
      if (rdform.eq.2) read(infile,121,end=9900) (adum(k),k=1,6)
c     write(42,121) (adum(k),k=1,6)
      time = adum(2)
      freq =  adum(1)
      ibck = ibck + 1
      write (42,107) ibck
      if(newcc.eq.1) go to 5
C BLOCK 14 is the non incremental data that is 
C put on the post file every inc......the 
C  go to 5 statement starts over....
C   continue
C
C read the distributed load information
C  Block 15
      ibck = ibck + 1
      write (42,107) ibck
      if (ndistl.eq.0) go to 125
      if (rdform.eq.1) call seqty(infile,adum,ndistl,0)
      if (rdform.eq.2) read(infile,121,end=9900) (adum(k),k=1,ndistl)
c     write(42,121) (adum(k),k=1,ndistl)
125   continue
C  Block 16 - spring forces
      ibck = ibck + 1
      write (42,107) ibck
      if (nsprng.eq.0) go to 135
      do 131 i = 1,nsprng
      if (rdform.eq.1) call seqty(infile,adum,2,0)
      if (rdform.eq.2) read(infile,121,end=9900) (adum(k),k=1,2)
c     write(42,121) (adum(k),k=1,2)
131   continue
135   continue
C Block 17 - magnitudes of die forces
      ibck = ibck + 1
      write (42,107) ibck
      if(ndie.eq.0) go to 75
      do 76 i =1,ndie
      if (rdform.eq.1) call seqty(infile,adum,18,0)
      if (rdform.eq.2) read(infile,121,end=9900) (adum(k),k=1,18)
c     write(42,121) (adum(k),k=1,18)
76    continue
75    continue
C block 18 - element integration point values
      ibck = ibck + 1
      write (42,107) ibck
      if(irezon.eq.3.or.irezon.eq.4) go to 54
      do 52 ne = 1,mnum
      do 53 ni = 1,nstres
      if (rdform.eq.1) call seqty(infile,adum,inum,0)
      if (rdform.eq.2) read(infile,121,end=9900) (adum(k),k=1,inum)
c     write(42,121) (adum(k),k=1,inum)
      if(inc.ne.numinc) go to 53
      ndelta = jelem(ne)
      do 23 mt =1,6
      if(mtstress.ne.0) stress(ni,mt,ndelta) = adum(mtstress + mt - 1)
      if(mtttrain.ne.0) ttrain(ni,mt,ndelta) = adum(mtttrain + mt - 1)
      if(mteplast.ne.0) epstrn(ni,mt,ndelta) = adum(mteplast + mt - 1)
      write (42,9145) ne,ni,stress(ni,mt,ndelta)
23    continue
      strain(ni,ndelta) = adum(mtstrain)
       write (42,9155) ne,ni,strain(ni,ndelta)
53    continue
c     write(42,8155) inc, numinc
8155  format(' line 53:increment number',i5,' requested inc ',i5)
52    continue
54    continue
c block 19 - nodal variable data
      ibck = ibck + 1
      write (42,107) ibck
      if(knod.eq.0) go to 80
      do 55 nn=1,lnum
      write(42,197) inod,knod,nn
197   format(' inod = ',i5,'  knod = ',i5,'  node no ',i5)
      if (rdform.eq.1) call seqty(infile,adum,knod,0)
      if (rdform.eq.2) read(infile,121,end=9900) (adum(k),k=1,knod)
c     write(42,121) (adum(k),k=1,knod)
55    continue
C this finishes the loop for the all increments
      ml = ll -1 
      write(6,192) ml
192   format(' finished reading increment ',i5)
      if(inc.eq.numinc) go to 1950
80    continue
1950  continue
      go to 1951
c*************************return
c     return
c*************************return
C    This will stop MARC - there is an error 
C           during the reading of the post file
9900  write(6,9999) ibck
      write(6,111) idum
      stop
C    This will stop MARC - there is an error 
C           during the opening of the post file
 321  write(6,9999) ibck
      stop
C    stop if the post file does not match the current model
c      or if there is no stress or strain data on the post file
C    This will stop MARC
149   Write(6,49)
      stop
141   write(6,241)
      stop
1951   continue
c     write(42,187) ne,nstres,inum,mnum,ni
187   format(' element number ',i3,' nstress ',i3,' inum ',i3
     *,' no of elements ',i3,' int pts ',i3)
C  if mtype = 1 then stress is requested
C  ne is element number and ni is int point number
C for stress the array should have 6 components of stress for
C  the element at a given int point
      If(mtype.eq.1)  then
    	   do 152 istuff = 1,6
	   sarray(istuff) = stress(intpt,istuff,melem)
c          write (42,9145) melem,intpt,sarray(istuff)
9145  Format(' this is the stress array for elem,intpt loop, value',
     *2i7,e10.3)
152        continue
	else
       if(mtype.eq.2) then
C  mtype = 2 then strain requested
C   ne is the int point number and ne is the element number
C  for strain the array should have equiv strain for each
C   int point for the given element
	 iend = nstres
	 do 153 istuff = 1,iend
	 sarray(istuff) = strain(istuff,melem)
c      write (42,9155) melem,istuff,sarray(istuff)
9155  Format(' this is the strain array for elem,int pt, value',
     *2i7,e10.3)
153    continue
       else
	 go to 100
	 endif
      endif
100   continue
      end
      subroutine seqty(lfn,fword,nsize,ired)                                 dp
c 
c* * * * * *
c     convert double precision array to single precision and write to post tape
c
c     lfn          logical file name
c     fword        first word address of array
c     ired         read/write flag.  set to 0 for read, 1 for write
c
c* * * * * *
      double precision fword(nsize),temp                                      dp
      real*4 xxx(200)                                                         sp
c     write(42,101) lfn,nsize,ired
101   format('sub seqty',3i5)
c     call mtrace(6hseqmts,1,0)                                         tr
c     if(ired.eq.1) then
c     do 100 kkk=1,nsize
c     xxx(kkk)=fword(kkk)
c 100 continue
c     endif
      call seqmt(lfn,xxx,nsize,ired)                                          dp
c     if(ired.eq.0) then
      do 200 kkk=1,nsize
      temp=xxx(kkk)
      fword(kkk)=temp
  200 continue
c     endif
c     call mtrace(6hseqmts,2,0)                                         tr
      return                                                                  dp
      end                                                                     dp
      subroutine seqmt (lfn,fword,nwords,ired)
      dimension fword(nwords)
c  ired   -2   rewind lfn
c  ired   -1   backspace nwords on lfn
c  ired    0   read from lfn
c  ired    1   write to lfn
c  ired    2   write end file on lfn
      jred = ired +3
      go to (10,20,30,40,50),jred
10    continue
      rewind lfn
      go to 100
20    continue
      backspace lfn
      go to 100
30    continue
      read(lfn,end=91) fword
      go to 100
40    continue
      write(lfn) fword
      go to 100
50    continue
      end file lfn
      go to 100
91    continue
      write(6,191) lfn
191   format(44h0sequential i/o error -- end of file on unit, i5)
      stop
100   continue
      return
      end


      subroutine plotv(v,s,sp,etot,eplas,ecreep,t,mx,nx,layer,ndi,
     * nshear,jpltcd)
c    purpose: add total and plastic strain tensors to initial values
c    purpose: then place on post file
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    *******************************
      implicit real*8 (a-h,o-z)                                               dp
      common /mydata/ stress,ttrain,epstrn
      dimension stress(4,6,9000) 
      dimension ttrain(4,6,9000)
      dimension epstrn(4,6,9000)
      dimension s(1),etot(1),eplas(1),ecreep(1),sp(1)
      if(jpltcd.ge.1.and.jpltcd.le.6) then
         v=etot(jpltcd)+ttrain(nx,jpltcd,mx)
      else if(jpltcd.ge.11.and.jpltcd.le.16) then
         v=eplas(jpltcd-10)+epstrn(nx,jpltcd-10,mx)
      end if
      return
      end