source: PSPA/parmelaPSPA/trunk/geners.f @ 315

      subroutine geners
c---generate misalignment errors
c---------------------------------------------------------------------------
      save
c
      include 'param_sz.h'
      include 'constcom.h'
      include 'misccom.h'
      include 'syscom.h'
      include 'var_char.h'
      include 'ucom.h'
c
      common/errors/eraln(5,0:lmx)
c--------------------------------------------------------------------------
c*
c---arguments are in array vv. first 3 args are ntype, n1, n2.  ntype
c---defines the type of misalignment to apply in elements n1 thru n2.
c---mtype=1, specific displacements of each begining of element are given in
c---         vv(4) thru vv(7).   (dx1,dy1,dx2,dy2)
c---mtype=2, random displacements independently in x and y, no tilt.
c---         tolerances are given in vv(4) and vv(5).  (dx,dy)
c---mtype=3, random displacements independently in x and y at begining
c---         of element.  tolerances in vv(4), vv(5).
c---mtype=4, random displacements independently in x and y at both ends.
c---         (dx1,dy1,dx2,dy2)
c---mtype=5, random radial displacement, no tilt.  vv(4)=dr
c---mtype=6, random radial displacement at end (vv(4)), no initial disp.
c---mtype=7, random radial displacements at each end.  vv(4), vv(5)
c---mtype=8, specific displacement and change in direction at begining of
c---         element are given in vv(4) thru vv(7). (dx1,dy1,theatax1,
c---         theatay1) change in direction given in degrees.
c---mtype=9, random radial displacements at begining of element vv(4),
c---         random angular displacement vv(5), and a maximum total
c---         radial displacement vv(6). The angular displacement is with
c---         respect to the orginal axis in units of radians.
c---         This type only applys errors to non-zero-length elements.
      mtype=vv(1)
      n1=vv(2)
      n2=vv(3)
      if(mtype.eq.9 .and. (vv(4).ge.vv(6) .or. vv(5).gt.0.1 
     * .or. n2.ge.nel)) then
      write(ndiag,*)' bad arguments on errors card'
      call appendparm
      stop ' Abnormal stop geners '
      endif
      do 100 n=n1,n2
      eraln(1,n)=mtype
      if(mtype.eq.9)go to 90
      do 5 i=2,5
      eraln(i,n)=0.
    5 continue
      go to (10,20,30,40,50,60,70,80),mtype
   10 continue
      eraln(2,n)=vv(4)
      eraln(4,n)=vv(5)
      if(el(1,n).le.0.)go to 100
      eraln(3,n)=(vv(6)-vv(4))/el(1,n)
      eraln(5,n)=(vv(7)-vv(5))/el(1,n)
      go to 100
   20 continue
      eraln(2,n)=2.*vv(4)*(.5-ranf())
      eraln(4,n)=2.*vv(5)*(.5-ranf())
      go to 100
   30 continue
      if(el(1,n).le.0.)go to 100
      eraln(3,n)=2.*vv(4)*(.5-ranf())/el(1,n)
      eraln(5,n)=2.*vv(5)*(.5-ranf())/el(1,n)
      go to 100
   40 continue
      eraln(2,n)=2.*vv(4)*(.5-ranf())
      eraln(4,n)=2.*vv(5)*(.5-ranf())
      if(el(1,n).le.0.)go to 100
      eraln(3,n)=(2.*vv(6)*(.5-ranf())-eraln(2,n))/el(1,n)
      eraln(5,n)=(2.*vv(7)*(.5-ranf())-eraln(4,n))/el(1,n)
      go to 100
   50 continue
      r=vv(4)*ranf()
      theta=twopi*ranf()
      dx=r*cos(theta)
      dy=r*sin(theta)
      eraln(2,n)=dx
      eraln(4,n)=dy
      go to 100
   60 continue
      if(el(1,n).le.0.)go to 100
      r=vv(4)*ranf()
      theta=twopi*ranf()
      eraln(3,n)=r*cos(theta)/el(1,n)
      eraln(5,n)=r*sin(theta)/el(1,n)
      go to 100
   70 continue
      r=vv(4)*ranf()
      theta=twopi*ranf()
      eraln(2,n)=r*cos(theta)
      eraln(4,n)=r*sin(theta)
      if(el(1,n).le.0.)go to 100
      r=vv(5)*ranf()
      theta=twopi*ranf()
      eraln(3,n)=(r*cos(theta)-eraln(2,n))/el(1,n)
      eraln(5,n)=(r*sin(theta)-eraln(4,n))/el(1,n)
      go to 100
   80 continue
      eraln(2,n)=vv(4)
      eraln(4,n)=vv(5)
      eraln(3,n)=sin(vv(6)*radian)
      eraln(5,n)=sin(vv(7)*radian)
      go to 100
   90 continue
      if(n.eq.n1)then
      xtotal=0.
      ytotal=0.
      eraln(3,n)=0.
      eraln(5,n)=0.
      eraln(1,n2+1)=mtype
      endif
      if(el(1,n).gt.0.)then
   91   continue
        r=vv(4)*ranf()
        theta=twopi*ranf()
        eraln(2,n)=r*cos(theta)
        eraln(4,n)=r*sin(theta)
        if((eraln(2,n)+xtotal)**2+(eraln(4,n)+ytotal)**2.gt.vv(6)**2)
     *  go to 91
      xtotal=xtotal+eraln(2,n)
      ytotal=ytotal+eraln(4,n)
      else
        eraln(2,n)=0.
        eraln(4,n)=0.
      endif
      if(el(1,n).gt.0.)then
   92   continue
        r=vv(5)*ranf()
        theta=twopi*ranf()
        dx=r*cos(theta)
        dy=r*sin(theta)
        if((dx*el(1,n)+xtotal)**2+(dy*el(1,n)+ytotal)**2.gt.vv(6)**2)
     *  go to 92
      xtotal=xtotal+dx*el(1,n)
      ytotal=ytotal+dy*el(1,n)
      eraln(3,n)=dx+eraln(3,n)
      eraln(5,n)=dy+eraln(5,n)
      eraln(3,n+1)=-dx
      eraln(5,n+1)=-dy
      else
      eraln(3,n+1)=0.
      eraln(5,n+1)=0.
      endif
        if(n.eq.n2)then
        eraln(2,n+1)=-xtotal
        eraln(4,n+1)=-ytotal
        endif
  100 continue
      return
      end
c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*