/NOPR
/NOLIST
/nopr
/out,scratch
!   torqsum.mac
!   Macro to SUM  magnetic torque
!   arg1  = first component name
!   arg2  = 2nd component name
!   arg3  = 3rd component name
!   arg4  = 4th component name
!   arg5  = 5th component name
!   arg6  = 6th component name
!   arg7  = 7th component name
!   arg8  = 8th component name
!   arg9  = 9th component name
!
!   This macro uses the _cmpn array of components generated by FMAGBC
!   If the arguement list is blank the array from FMAGBC is used.
!
!
_nodo=0
*get,_rout,active,,rout
*if,_rout,ne,31,then
  _nodo=1
*msg,warn
 Enter POST1 before issuing this command macro
*endif
/out,scratch
/uis,msgpop,3
*if,_nodo,eq,1,:end
/uis,msgpop
*get,_antyp,active,,anty

 *if,_antyp,eq,3,then
  *get,_lsno2,active,,set,lstp
  *if,_lsno2,eq,0,then
   *msg,warn
   No data set detected in database, Last data set used (see SET command)
  _last=1
  *endif
  *if,_last,eq,1,then
   set,last,1
   *else
   set,_lsno2,1
  *endif
 *endif
*get,_dimn,active,,solu,dimn
!  convert keydim from new to old meaning   pck 10/98 qt-13025
!  new:  0=planar, 1=axisym, 2=axisym-harmonic, 3=3d
!  old:  1=axisym, 2=planar, 3=3d
*if,_dimn,eq,0,then
_dimn=2
*endif
!  convert to new usage as convenient
!  end of keydim conversion
cm,_elm,elem

! active number of element types defined
*get,_etmx,etyp,,num,max


*get,_mnu,active,,menu
_mnu=0
!    definition of the array to locate the force in the etable
!  _locet(i,j)  = location in the etable for torque
!    i=1,2 for VW and MX torque
!    j=1,2 for PLANE13 and PLANE53
*set,_locet
*dim,_locet,,2,2
!             VW    MX
_locet(1,1)=18,     17      ! PLANE53
_locet(1,2)=37,     36          ! PLANE13
 !
!  definition of the array for the torque obtained from ssum
!   _for(I,J,K) = torque
!     I=1,2,3,4,5,6,7,8,9  for the Ith component
!     J=1,2  for element type (1=PLANE53), (2=PLANE13)
!     K=1,2  for the maxwells stress(K=1) and the virtual work (K=2)
*set,_for
*dim,_for,,9,2,2

_iappl=0
!  check if the array _CMPN already exists

_prefn=1
!   _prefn=1 means that the first arguement is blank, meaning that the
!   _cmpn array is to be used in the list of components
_arg1=arg1
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
  !  this is a valid character and is taken to mean that the user
  !  wants to specify the components in the arguement list.  If it is
  !  an invalid character, maybe it is a zero, which means use the existing
  !  array data (because the _prefn=1 before the *if )
  _prefn=0
*endif

_iscmpn=0
*get,_cchk,parm,_cmpn,type
*if,_cchk,eq,-1,then
 *msg,warn
 No components are defined for force summary
 /out,scratch
 *go,:end
*endif
*if,_prefn,eq,0,then
!  the existing list is to be used. save it to another file
!  _s_cmpn
 _iscmpn=1
 *if,_cchk,eq,4,then
  *set,_s_cmpn
  *dim,_s_cmpn,char,9
  *do,_icom,1,9
    _s_cmpn(_icom)=_cmpn(_icom)
  *enddo
 *endif
*endif
*if,_idbug,eq,1,then
*stat,_s_cmpn
*stat,_cmpn
*endif

*if,_prefn,eq,0,then
!The first arguement is not blank
!therefore the components will come through the arguement input
 *set,_cmpn
 *dim,_cmpn,char,9
 _cmpn(1)='  ','  ','  ','  ','  ','  ','  ','  ','  '

_arg1=arg1
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(1)=arg1
!   *msg,info,arg1
!     using the input arguement:  %c
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of a valid character string
*endif


_arg1=arg2
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(2)=arg2
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg3
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(3)=arg3
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg4
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then

_cmpn(4)=arg4
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg5
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(5)=arg5
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg6
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(6)=arg6
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg7
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(7)=arg7
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg8
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(8)=arg8
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif


_arg1=arg9
*get,_cchk,parm,_arg1,type
*if,_cchk,ge,3,then
_cmpn(9)=arg9
*elseif,_arg1,ne,0,then
 *msg,warn
 The Component name must consist of valid character string
*endif

!     end of new code   c_5/8/95

*endif

*set,_actm
*dim,_actm,,9

*set,_elmtd
*dim,_elmtd,,3

cm,_curei,elem
cm,_curni,node
*if,_prefn,eq,1,then
!  the first arguement was blank => components will come through the array
/out,scratch
/uis,msgpop,3
!*do,_inum,1,9
! *if,_cmpn(_inum),eq,' ',exit
!*enddo
/uis,msgpop
_inum=_inum-1
*else
!  the components will come through the arguement list
_inum=1
!_inum=9
*endif

*do,_icom,1,_inum

_errlv=0
_nodo=0
*if,_cmpn(_icom),eq,' ',then
_nodo=1
!  *msg,info,_icom
!   _cmpn tested blank: %i
*endif
!    check if the current component is blank, if so, the end of the list
!    has been reached
/out,scratch
/uis,msgpop,3
*if,_nodo,eq,1,exit
/uis,msgpop

*if,_nodo,eq,0,then

*get,_type,comp,%_cmpn(_icom)%,type
*if,_type,eq,0,then
!   this is NOT a valid component
     *msg,warn,_cmpn(_icom)
     Component %c is not defined.
      _nodo=1
      _errlv=_errlv+1
      _elnum=0
*else
!   check for elements
   cmsel,,%_cmpn(_icom)%
   *get,_elnum,elem,,count
   *if,_elnum,eq,0,then
    *msg,warn,_cmpn(_icom)
    Component %c has no elements associated with it.&
    No force boundary conditions were applied to this component
    _cmpn(_icom)='  '
    _errlv=_errlv+1
   *endif
*endif

*if,_errlv,eq,0,then

 *get,_sysr,active,,rsys             ! get active RSYS c.s.

rsys,0

!  get the forces for MVDI & Maxwells stress conditions
cmsel,,%_cmpn(_icom)%
nsel,,ext
esln
cm,_temp,elem
cmsel,u,%_cmpn(_icom)%

esel,r,ename,,53
etab,fvw_x1,nmisc,_locet(1,1)
etab,fmx_x1,nmisc,_locet(2,1)
cmsel,s,_temp
esel,r,ename,,13
etab,fvw_x2,nmisc,_locet(1,2)
etab,fmx_x2,nmisc,_locet(2,2)
cmsel,s,_temp
/out,scratch
ssum
*get,_for(_icom,1,2),ssum,,item,fvw_x1  ! plane53
*get,_for(_icom,2,2),ssum,,item,fvw_x2  ! plane13
*get,_for(_icom,1,1),ssum,,item,fmx_x1  ! plane53
*get,_for(_icom,2,1),ssum,,item,fmx_x2  ! plane13

_iappl=_iappl+1
_actm(_icom)=1

*endif

*endif
*enddo

*if,_iappl,ge,1,then

_imatlm=2
*set,_cmpnw
*dim,_cmpnw,char,1,9
*set,_chnum
*dim,_chnum,char,9
_chnum(1)='one','two','three','four','five','six','seven','eight','nine'
*do,_icom1,1,8
  *do,_icom2,1,9-_icom1+1
   *if,_actm(_icom1),eq,0,then
     *do,_icom3,_icom1,8
      _actm(_icom3)=_actm(_icom3+1)
      _cmpn(_icom3)=_cmpn(_icom3+1)
      *do,_icom4,1,_imatlm
       _for(_icom3,_icom4,1)=_for(_icom3+1,_icom4,1)
       _for(_icom3,_icom4,2)=_for(_icom3+1,_icom4,2)
      *enddo
     *enddo
   *endif
  *enddo
*enddo

*do,_icom1,1,_iappl
_cmpnw(1,_icom1)=_cmpn(_icom1)
*enddo

 *get,_unit,active,,solu,emunit      ! 1=mks, 2=cgs, 3=user
*if,_unit,eq,0,then
_unit=1
*endif
*set,_pr_unt
*dim,_pr_unt,char,3,2
_pr_unt(1,1)='( N*m ) ','(Dyne*cm)','(User)'
_pr_unt(1,2)='(N*m/m) ','Dyne*cm/cm','(User)'
_iprl=2
*set,_blnka
*dim,_blnka,char,1
_blnka(1)=' '

*set,_tfor
*dim,_tfor,,2,3
!    _tfor(I,J) = sum of torque
!         I=1(maxwell stress), 2(virtual work)
!         J=1,2  (1-plane53,  2-plane13)
*do,_icom1,1,_iappl
 *do,_icom2,1,2
   _tfor(1,_icom2)=_tfor(1,_icom2)+_for(_icom1,_icom2,1)
   _tfor(2,_icom2)=_tfor(2,_icom2)+_for(_icom1,_icom2,2)
 *enddo
*enddo
torqvw = _tfor(2,1)+_tfor(2,2)  ! total torque - VW
torqmx = _tfor(1,1)+_tfor(1,2)  ! total torque - MX

!   units flag
!   per m flag
!   torque 2d  VW
*set,_d_at
*dim,_d_at,,1,3
*get,_d_at(1,1),active,,set,lstp
*get,_d_at(1,2),active,,set,sbst
*get,_d_at(1,3),active,,set,time
/nopr
*if,_mg1+_mg2,eq,0,then

*if,_mnu,ne,0,then
/out,torqsum,out
*else
*endif
*if,_mnu,ne,0,then
 *if,_mg1,eq,0,then
  *uili,torqsum,out
 *endif
*endif

*endif      !  end of the bypass of the transient

*endif     !   end of _iappl check :  moved to end 6/4/95#1
cmsel,,_curei
cmsel,,_curni
cmdele,_curei
cmdele,_curni
rsys,_sysr
*if,_iscmpn,eq,1,then
*do,_icom,1,9
 _cmpn(_icom)= _s_cmpn(_icom)
*enddo
*endif
*if,_idbug,eq,1,then
  *stat,_s_cmpn
  *stat,_cmpn
*endif

:end
*if,_idbug,eq,0,then
!  delete parameters except for array of component names.
*set,_actm  $ *set,_chnum $  *set,_cmpnw     $  _dely=
*set,_elmtd $ *set,_for   $  *set,_pr_unt    $  *set,_tfor
*set,_s_cmpn
_elmx2= $   _elnum=  $  _elnum2= $   _errlv= $   _appl= $   _icom1=
_imat1= $   _imatlm= $  _magflg= $   _mnu=   $   _nodo= $   _rout=
_icom2= $   _icom3=  $  _elmatc= $   _elnum1=$   _iappl=$   _icom=
_unit=  $   _predn=  $  _arg1=   $   _iscmpn= $_antyp=
_last=  $   _lsno2=  $ _axi=     $ _etmx= $ _axikey= $ _i7=
etable,fvw_x1,erase
etable,fvw_x2,erase
etable,fmx_x1,erase
etable,fmx_x2,erase
cmdele,_elm
*endif




/UIS,MSGPOP,DEFA
/GOPR
/GOLIST

