/out,_data,out
! /gopr 
fini
/uis,msgpop,3
/prep7
*get,_immed,active,,imme
immed
alls
numc,node

_pbccp=arg4
*if,_pbccp,ne,0,then
ksel,all
*get,_kpmax,kp,,num,max
lsel,none
ksel,none
*endif
*set,tcpu
*dim,tcpu,,16
*get,tcpu(1),active,,time,cpu
_ok=0
!     1-/12/94   used for machine model where stitiching is to occur
!
*get,_nops,active,,prkey
*get,_mnu,active,,menu
*if,_mnu,eq,0,then
 _dely=0
 *else
 _dely=5
*endif
*get,_arout,active,,rout
*if,_arout,ne,17,then
 *msg,warn
 Enter PREP7 before issuing this command macro
 _ok=1
*endif
/com,  Macro for applying periodic boundary conditions at two symmetry planes
/com,
/com,              (@r=arg5) X                          X (@r=arg5)
/com,                         X                        X
/com,                          X                      X
/com,               2nd plane   X                    X    1st plane
/com,            (@theta=arg2)   X                  X   (@ theta=arg1)
/com,                             X                X
/com,                    (@r=arg4) X              X  (@r=arg4)
/com,
/com,                                      
/com,                                      
/com,                                      O  (global origin) 
/com,
/com,  *** Assumptions
/com,      Two-dimensional planar analysis
/com,      Symmetry planes are symmetric (in theta) w/r to Global origin
/com,      Nodes at inner and outer radius do not write constraint equations
/com,
/com,  *** ANSYS Revision 5.0
/com,  *** Macro version 2
!       PARAMTER INPUT:
/com,      arg1 = type of periodic condition (0=odd, 1=even)
/com,             (odd sets AZ=-AZ, even sets AZ=AZ)
!          arg4 = flag to generate the lines to show connectivity
!                 of couple sets or constraint equations.
!               = 0 (no action)
!               NE 0  generate the lines (component _PERCON  )
!  /out
/com,
/com,  *** INTERNAL ARGUEMENT paramters
/com,      arg1 = angle in degrees for location of 1st plane
/com,      arg2 = angle in degrees for location of 2nd plane
/com,      arg3 = tolerance on angle (degrees)
/com,      arg4 = minimum radius
/com,      arg5 = maximum radius
/com,      arg6 = tolerance on radius
/com,      arg7 = type of periodic condition (0=odd, 1=even)
/com,             (odd sets AZ=-AZ, even sets AZ=AZ)
/com,
nsel,all
*get,tcpu(2),active,,time,cpu
*get,_ndmax,node,,num,max
*get,_cemx,active,,ce
!    nsel,r,ce,,1,_cemx
!    cm,_remnod,node
cmsel,,rotor
esel,r,mat,,1                      !   6/26/96
!esel,r,real,,5                     !   10/31/94
nsle                               !   10/31/94
csys,1
*get,_rdmx,node,,mxloc,x
*get,_rdmn,node,,mnloc,x
*get,_trmx,node,,mxloc,y
*get,_trmn,node,,mnloc,y
_rdtol=(_rdmx-_rdmn)/100             !   10/31/94
_rdtolr=_rdtol
nsel,r,loc,x,_rdmx-_rdtol,_rdmx+_rdtol
*get,_ecntr,elem,,count
!   cmsel,a,_remnod
cm,_remnod,node
cmsel,,stator
esel,r,mat,,1
nsle
*get,_rdmx,node,,mxloc,x
*get,_rdmn,node,,mnloc,x
*get,_tsmx,node,,mxloc,y
*get,_tsmn,node,,mnloc,y
_rdtol=(_rdmx-_rdmn)/100
_rdtols=_rdtol
nsel,r,loc,x,_rdmn-_rdtol,_rdmn+_rdtol
*get,_ecnts,elem,,count
esln
nsle
cmsel,a,_remnod
cm,_remnod,node
*get,tcpu(3),active,,time,cpu
nsel,all
*get,tcpu(4),active,,time,cpu
cmsel,u,_remnod
cm,_perbcn,node
_delrsth=_trmx-_tsmx

_mv_rot=0                          ! 6/26/96
*if,abs(_delrsth),gt,.001,then
  cmsel,,rotor                     ! 6/26/96
  csys,1                           ! 6/26/96
  ngen,2,,all,,,0,-_delrsth        ! 6/26/96
  cmsel,,_perbcn                   ! 6/26/96
  _mv_rot=1                        ! 6/26/96
!    mvrotor                       ! 6/26/96
*endif

csys,1
*get,_thtmx,node,,mxloc,y
*get,_thtmn,node,,mnloc,y
*get,_rdmx,node,,mxloc,x
*get,_rdmn,node,,mnloc,x
arg7=arg1        !  11/15/94
_evodi=1     !    odd
*if,arg7,ge,1,then
_evodi=2     !   even
*endif
arg1=_thtmn
arg2=_thtmx
arg4=_rdmn
arg5=_rdmx
arg6=_rdtols
*if,_rdtolr,lt,_rdtols,then
 arg6=_rdtolr
*endif
arg3=.01  !  (_thtmx-_thtmn)/(_ecnts*2)    !   9/17/99
*if,_ecntr,gt,_ecnts,then
arg3=.01  !  (_thtmx-_thtmn)/(_ecntr*2)    !   9/17/99
*endif
*get,_sysc,active,,csys
csys,1
*get,tcpu(5),active,,time,cpu
*if,abs(_trmx-_trmn),gt,180,then
 *msg,info
 Periodic conditions are NOT appropriate for full 360d models
 _ok=1
*endif
*if,arg1,eq,arg2,then
 *msg,error
 Invalid angle input on symmetry planes, please reissue command macro
 _ok=1
*endif
*if,arg5,eq,0,then
 *msg,error
 Missing input for maximum radius, please reissue command macro
 _ok=1
*endif
*get,tcpu(6),active,,time,cpu
*if,_ok,ne,1,then
 nsel,all
 cmsel,u,_remnod
 nsel,r,loc,y,arg2-arg3,arg2+arg3  ! select nodes at 2nd plane
 nsel,r,loc,x,arg4+arg6,arg5-arg6  ! select nodes radially
 cm,_pln2,node
 *get,_cnt2,node,,count            ! get node count on 2nd plane
cpdel,all,,,any
cedel,all,,,any
numc,ce
numc,cp
 *get,_cemx,active,,ce             ! get highest ce equation number
 *get,_cpmx,active,,cp             ! get highest cp equation number
 _ice=_cemx+1
 _icp=_cpmx+1
 _ceorg=_ice                       ! save original ce number
 _cporg=_icp
*set,_mskv1
*dim,_mskv1,,_ndmax
*set,_mskv2
*dim,_mskv2,,_ndmax

*get,tcpu(7),active,,time,cpu

*get,tcpu(8),active,,time,cpu
 *set,_rdpln2
 *dim,_rdpln2,,_ndmax
 *set,_rdcpln2
 *dim,_rdcpln2,,_cnt2
 *vget,_mskv2(1),node,,nsel
 *voper,_mskv2(1),_mskv2(1),ge,0
 *vmask,_mskv2(1)
 csys,1
 *vget,_rdpln2(1),node,1,loc,x
 *cfop,_radn
 *vmask,_mskv2(1)
 *vwrite,_rdpln2(1)
 (f20.10)
 *cfcl
 *vread,_rdcpln2(1),_radn
 (f20.10)
*get,tcpu(9),active,,time,cpu

 nsel,all
 cmsel,u,_remnod
 nsel,r,loc,y,arg1-arg3,arg1+arg3  ! select nodes at 1st plane
 nsel,r,loc,x,arg4+arg6,arg5-arg6  ! select nodes radially
 cm,_pln1,node
 *get,_cnt1,node,,count
 cmsel,a,_pln2

 *if,_cnt1,eq,0,then
  *msg,error 
  No nodes selected on 1st plane, please reissue command macro
  /wait,_dely
  _ok=1
 *else
  *if,_cnt2,eq,0,then
   *msg,error
   No nodes selected on 2nd plane, please reissue command macro
   /wait,_dely
   _ok=1
  *else
   *if,_cnt1,ne,_cnt2,then
    *msg,error
    Number of nodes on symmetry planes do not match
    /wait,_dely
    _ok=1
   *endif
  *endif
 *endif
*endif

*if,_ok,ne,1,then   ! #1
*if,_pbccp,eq,0,then
 *if,arg7,eq,0,then
  *get,tcpu(11),active,,time,cpu
  *do,i_,1,_cnt1
    _ub1=node(_rdcpln2(i_),_thtmn,0)
    _ub2=node(_rdcpln2(i_),_thtmx,0)
    ce,_ice,0,_ub1,az,1,_ub2,az,1
    _ice=_ice+1
  *enddo
  *get,tcpu(12),active,,time,cpu
 *elseif,arg7,ge,1,then
  *get,tcpu(13),active,,time,cpu
  *do,i_,1,_cnt1
   /gopr
   *msg,info,i_
    cycle counter i_:  %i
   _ub1=node(_rdcpln2(i_),_thtmn,0)
   _ub2=node(_rdcpln2(i_),_thtmx,0)

   cp,_icp,az,_ub1,_ub2
   _icp=_icp+1
  *enddo
  *get,tcpu(14),active,,time,cpu
 *endif
*endif

*if,_pbccp,ne,0,then
i_2=0
 *if,arg7,eq,0,then
  *get,tcpu(11),active,,time,cpu
  *do,i_,1,_cnt1
    _ub1=node(_rdcpln2(i_),_thtmn,0)
    _ub2=node(_rdcpln2(i_),_thtmx,0)
    i_2=i_2+1
    k,_kpmax+i_2,_rdcpln2(i_),_thtmn,0
    i_2=i_2+1
    k,_kpmax+i_2,_rdcpln2(i_),_thtmx,0
    l,_kpmax+i_2-1,_kpmax+i_2
    ce,_ice,0,_ub1,az,1,_ub2,az,1
    _ice=_ice+1
  *enddo
  *get,tcpu(12),active,,time,cpu
 *elseif,arg7,ge,1,then
 /kpmax
 *get,tcpu(13),active,,time,cpu
  *do,i_,1,_cnt1
   _ub1=node(_rdcpln2(i_),_thtmn,0)
   _ub2=node(_rdcpln2(i_),_thtmx,0)
    i_2=i_2+1
    k,_kpmax+i_2,_rdcpln2(i_),_thtmn,0
    i_2=i_2+1
    k,_kpmax+i_2,_rdcpln2(i_),_thtmx,0
    l,_kpmax+i_2-1,_kpmax+i_2
    cp,_icp,az,_ub1,_ub2
   _icp=_icp+1
  *enddo
  *get,tcpu(14),active,,time,cpu
  *endif
  cm,_percon,line
  /auto
  dsys
  nsel,all
  /pnum,node
*if,_nomsg,eq,0,then
  nplo
*endif
  /user
  /noer
  /pnum,mat
  /pnum,real
  /pnum,type
  /pnum,line,1
  /pnum,kpoi,0
  /num,1
  lplo
  /erase
  /auto
*endif



*get,tcpu(15),active,,time,cpu
*get,tcpu(16),active,,time,cpu

*if,abs(_delrsth),gt,.001,then
  cmsel,,rotor                     ! 6/26/96
  csys,1                           ! 6/26/96
  ngen,2,,all,,,0,_delrsth        ! 6/26/96
  cmsel,,_perbcn                   ! 6/26/96
  _mv_rot=1                        ! 6/26/96
!    mvrotor                       ! 6/26/96
*endif


tcpu0=tcpu(1)
!  *do,i_,1,16
!tcpu(i_)=tcpu(i_)-tcpu0
!*enddo
!*stat,tcpu
!   parsav,all,permach,par


!   *if,_ok,ne,1,then
cmsel,,stator
esel,r,ename,,9
_c_9=0
*get,_c_9,elem,,count
*if,_c_9,ne,0,then
  nsle
  csys,1
  *get,_thmn,node,,mnloc,y
  *get,_thmx,node,,mxloc,y
  *get,_rdmx,node,,mxloc,x
  _nd1=node(_rdmx,_thmx,0)
  _nd2=node(_rdmx,_thmn,0)
  nsel,,,,_nd1
  nsel,a,,,_nd2
  *if,arg7,eq,0,then
    cedel,all,,,all
    _ice=_ice+1
    ce,_ice,0,_nd1,az,1,_nd2,az,1
  *else
    cpdel,all,,,all
    _icp=_icp+1
    cp,_icp,az,_nd1,_nd2
  *endif
 alls
 numc,cp
 numc,ce
*endif


*set,_evodpr
*dim,_evodpr,char,2
_evodpr(1)='ODD','EVEN'
/nopr
/out,permach,sum
*msg,info
>_____________  SUMMARY  of  PERIODIC  CONDITIONS ____________<
*if,arg7,eq,0,then
 *msg,info,_evodpr(_evodi)
  Type of periodic Boundary Condition:_______________________ %c
 *msg,info,_ice-_ceorg
  Number of Constraint Equations for odd-periodicty:_________ %g
 *msg,info
  NOTE:
  *if,_c_9,eq,0,then
    *msg,info
    Nodes at inner and outer radii are not constrained
  *else
    *msg,info
    Nodes at inner radius are not constrained
  *endif

*endif

*if,arg7,ge,1,then
 /out,permach,sum
 *msg,info,_evodpr(_evodi)
  Type of periodic Boundary Condition:_______________________ %c
 *msg,info,_icp-_cporg
  Number of node couplings for even-periodicity:_____________ %g
 *msg,info
  NOTE:
  *if,_c_9,eq,0,then
    *msg,info
    Nodes at inner and outer radii are not coupled
  *else
    *msg,info
    Nodes at inner radius are not coupled
  *endif

*endif
/out,_data,,,append
*list,permach,sum
*if,_nops,eq,1,then
*uilist,permach,sum
*endif

*endif  !   #1  9/4/97


csys,_sysc
nsel,all
immed,_immed
/nopr
!   _arout= $_cemx= $_ceorg= $_cnt1= $_cnt2= $_cpmx= $_cporg=
!   _ice= $_icp= $_rc1= $_sysc= $_ub1= $_ub2= $i_= $_mnu= $_dely=
!   _dimn=    $  _mv_rot=
!   _ok=      $  _immed=  $  _c_9=
/uis,msgpop
esel,all
nsel,all
*if,_nomsg,eq,0,then
  nplot
*endif
*if,_nops,eq,0,then
 /nopr
 _nops=
 *else
 _nops=
 /go
*endif