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++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*