/out,g_cycle,out
/com,  extracts the forces and writes out the macro  ldfor.mac to load the
/com,  for the structural model.
/com,  5/30/00
/nerr,0,1e5
ftol=.1  !  forces lower than this are neglected
   rsys,1   !!!!   this line sets the forces to polar  !!
*if,_i_1,eq,1,then
  *set,cfn
  *dim,cfn,char,500
  *set,inum
  *dim,inum,,500
  *vfill,inum(1),ramp,100,1
  /nopr
  /out,ifnum,mac
  *vwrit,inum(1)
  ('ifnum',f4.0)
  /out,g_cycle,out,,append
  /gopr
  *vread,cfn(1),ifnum,mac
  (a8)
*endif

nsel,all
*get,ndmx,node,,num,max
*set,mskv
*dim,mskv,,ndmx
*set,mskv2
*dim,mskv2,,ndmx
*set,mskv3
*dim,mskv3,,ndmx
*set,mskv4
*dim,mskv4,,ndmx
*set,fn
*dim,fn,,ndmx,2
esel,,mat,,1
nsel,,ext
!nsel,r,ext
*vget,mskv(1),node,1,nsel
*voper,mskv(1),mskv(1),gt,0

*vmask,mskv(1)
*vget,fn(1,1),node,1,fmag,x
*vmask,mskv(1)
*vget,fn(1,2),node,1,fmag,y
*vabs,,1
*vmask,mskv(1)
*voper,mskv2(1),fn(1,1),gt,ftol
*vabs,,1
*vmask,mskv(1)
*voper,mskv3(1),fn(1,2),gt,ftol
*vabs,,1
*vmask,mskv(1)
*voper,mskv4(1),mskv2(1),add,mskv3(1)
*vabs,,1
*vmask,mskv(1)
*voper,mskv4(1),mskv4(1),gt,0

cm,fn,node
/nopr
/out,%cfn(_i_1)%,mac
*msg,info,_i_1
 !   cycle number %i 
 *msg,info,_meang
  !  mechanical angle:  %g
*msg,info
/nopr  !
*msg,info
cmsel,,fn  !
*msg,info
/pbc,f,1  !
*vmask,mskv4(1)
*vwrit,sequ,fn(1,1)
('f,'f10.0,',fx,',f10.4)
*vmask,mskv4(1)
*vwrit,sequ,fn(1,2)
('f,'f10.0,',fy,',f10.4)
/out,g_cycle,out,,append
/gopr
!*go,:end

*if,arg1,eq,1,then
 fini
 /prep7
 et,1,42
 rp5,1
 mp,ex,5,27e6*6498
 esel,,mat,,5
 nsle
 csys,1
 *get,rdmx,node,,mxloc,x
 d,node(rdmx,-135,0),uy,0
 d,node(rdmx,-45,0),all
 ldfor
*endif

:end

/gopr
parsav,all,temp,par
/out