Télécharger la plaquette Cast3M


fr en

Télécharger addite.eso

Retour à la liste

Numérotation des lignes : 

addite

  1. C ADDITE    SOURCE    CB215821  25/04/08    21:15:02     12227          
  2.  
  3. C  Sous-programme elementaire pour effectuer la translation, la rotation
  4. C  ou l'affinite d'un objet
  5. C  10/2003 : Prise en compte cas IDIM=1.
  6.  
  7.       SUBROUTINE ADDITE(X,IPT1,IPT2,ICPR,IARG)
  8.  
  9.       IMPLICIT INTEGER(I-N)
  10.       IMPLICIT REAL*8 (A-H,O-Z)
  11.  
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMCOORD
  17. -INC CCGEOME
  18. -INC CCTOURN
  19.  
  20.       DIMENSION X(*)
  21.       SEGMENT ICPR(nbpts)
  22.  
  23.       idimp1=IDIM+1
  24.       XVECS=XVEC
  25.       YVECS=YVEC
  26.       ZVECS=ZVEC
  27.       COSA=COS(ANGLE)
  28.       SINA=SIN(ANGLE)
  29.       ANG2=ANGLE*ANGLE
  30.  
  31. C  Initialisation du maillage IPT2 transforme de IPT1
  32.       NBSOUS=0
  33.       IF (IARG.EQ.0) THEN
  34.         NBREF=0
  35.       ELSE
  36.         NBREF=IPT1.LISREF(/1)
  37.       ENDIF
  38.       NBNN=IPT1.NUM(/1)
  39.       NBELEM=IPT1.NUM(/2)
  40.       SEGINI IPT2
  41.       IPT2.ITYPEL=IPT1.ITYPEL
  42.       DO i=1,NBELEM
  43.         IPT2.ICOLOR(i)=IPT1.ICOLOR(i)
  44.       ENDDO
  45.  
  46. C  ICLE / KCLE : indique la transformation a realiser
  47. C  KCLE = 1  : translation (operateurs PLUS,MOIN,DEDU 'TRAN')
  48. C  KCLE = 2  : rotation (operateurs TOUR,DEDU 'ROTA')
  49. C  KCLE = 3  : homothetie (operateur HOMO)
  50. C  KCLE = 4  : affinite (operateur AFFI)
  51. C  KCLE = 5  : symetrie point (operateur SYME 'POINT')
  52. C  KCLE = 6  : symetrie droite (operateur SYME 'DROIT')
  53. C  KCLE = 7  : symetrie plan (operateur SYME 'PLAN')
  54. C  KCLE = 8  : projection plan (operateur PROJ 'PLAN')
  55. C  KCLE = 9  : projection sphere (operateur PROJ 'SPHE')
  56. C  KCLE = 10 : projection cylindre (operateur PROJ 'CYLI')
  57. C  KCLE = 11 : projection conique (operateur PROJ 'CONI')
  58. C  KCLE = 12 : projection torique (operateur PROJ 'TORI')
  59. C  KCLE = 13 : projection droite (operateur PROJ 'DROI')
  60. C  KCLE = 14 : projection cercle (operateur PROJ 'CERC')
  61.       KCLE=ICLE
  62.       IF (ICLE.GE.10000) KCLE=ICLE-10000
  63.       IF (ICLE.LT.0) KCLE=ICLE+10000
  64.  
  65. C  Reservation de la place dans XCOOR
  66.       segdes mcoord
  67.       SEGACT MCOORD*mod
  68.       NPACT=NBPTS
  69.       NXCOUR=NPACT*idimp1
  70.       NBPTS=NPACT+NBELEM*NBNN
  71.       SEGADJ MCOORD
  72.  
  73. C  Boucle sur les noeuds du maillage
  74. C  Creation du noeud de IPT2 image de IPT1.NUM(i,j) et stocke dans ICPR
  75.       DO 10 j=1,NBELEM
  76.       DO 11 i=1,NBNN
  77. C  L'image de IPT1.NUM(i,j) a-t-elle deja ete creee ?
  78.       IF (ICPR(IPT1.NUM(i,j)).EQ.0) THEN
  79.         IREF=(IPT1.NUM(i,j)-1)*idimp1
  80.         GOTO (51,52,53,54,55,56,57,58,59,60,61,62,63,64),KCLE
  81. C  Translation de vecteur X :
  82.   51    DO k=1,IDIM
  83.           XCOOR(NXCOUR+k)=X(k)+XCOOR(IREF+k)
  84.         ENDDO
  85.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  86.         GOTO 70
  87. C  Rotation (2D/3D) :
  88.   52    XD=XCOOR(IREF+1)-XPT1
  89.         YD=XCOOR(IREF+2)-YPT1
  90.         ZD=0.
  91.         IF (IDIM.GE.3) ZD=XCOOR(IREF+3)-ZPT1
  92.         XE=XD*XV1+YD*YV1+ZD*ZV1
  93.         YE=XD*XV2+YD*YV2+ZD*ZV2
  94.         ZE=XD*XVEC+YD*YVEC+ZD*ZVEC
  95.         XD=XE*COSA-YE*SINA
  96.         YD=XE*SINA+YE*COSA
  97.         ZD=ZE
  98.         XCOOR(NXCOUR+1)=XD*XV1+YD*XV2+ZD*XVEC+XPT1
  99.         XCOOR(NXCOUR+2)=XD*YV1+YD*YV2+ZD*YVEC+YPT1
  100.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1
  101.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  102.         GOTO 70
  103. C  Homothetie :
  104.   53    XCOOR(NXCOUR+1)=(XCOOR(IREF+1)-XPT1)*ANGLE+XPT1
  105.         IF (IDIM.GE.2) XCOOR(NXCOUR+2)=(XCOOR(IREF+2)-YPT1)*ANGLE+YPT1
  106.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=(XCOOR(IREF+3)-ZPT1)*ANGLE+ZPT1
  107.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)*ANGLE
  108.         GOTO 70
  109. C  Affinite (2D/3D) :
  110.   54    XD=XCOOR(IREF+1)-XPT1
  111.         YD=XCOOR(IREF+2)-YPT1
  112.         ZD=0.
  113.         IF (IDIM.GE.3) ZD=XCOOR(IREF+3)-ZPT1
  114.         XE=XD*XV1+YD*YV1+ZD*ZV1
  115.         YE=XD*XV2+YD*YV2+ZD*ZV2
  116.         ZE=(XD*XVEC+YD*YVEC+ZD*ZVEC)*ANGLE
  117.         XCOOR(NXCOUR+1)=XE*XV1+YE*XV2+ZE*XVEC+XPT1
  118.         XCOOR(NXCOUR+2)=XE*YV1+YE*YV2+ZE*YVEC+YPT1
  119.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=XE*ZV1+YE*ZV2+ZE*ZVEC+ZPT1
  120.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  121.         GOTO 70
  122. C  Symetrie par rapport a un point :
  123.   55    XCOOR(NXCOUR+1)=2*XPT1-XCOOR(IREF+1)
  124.         IF (IDIM.GE.2) XCOOR(NXCOUR+2)=2*YPT1-XCOOR(IREF+2)
  125.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=2*ZPT1-XCOOR(IREF+3)
  126.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  127.         GOTO 70
  128. C  Symetrie par rapport a une droite (2D/3D) :
  129.   56    XD=XCOOR(IREF+1)-XPT1
  130.         YD=XCOOR(IREF+2)-YPT1
  131.         ZD=0.
  132.         IF (IDIM.GE.3) ZD=XCOOR(IREF+3)-ZPT1
  133.         PVEC=2*(XD*XVEC+YD*YVEC+ZD*ZVEC)
  134.         XCOOR(NXCOUR+1)=XPT1+XVEC*PVEC-XD
  135.         XCOOR(NXCOUR+2)=YPT1+YVEC*PVEC-YD
  136.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=ZPT1+ZVEC*PVEC-ZD
  137.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  138.         GOTO 70
  139. C  Symetrie par rapport a un plan (3D) :
  140.   57    XD=XCOOR(IREF+1)-XPT1
  141.         YD=XCOOR(IREF+2)-YPT1
  142.         ZD=XCOOR(IREF+3)-ZPT1
  143.         PVEC=2*(XD*XVEC+YD*YVEC+ZD*ZVEC)
  144.         XCOOR(NXCOUR+1)=XPT1+XD-XVEC*PVEC
  145.         XCOOR(NXCOUR+2)=YPT1+YD-YVEC*PVEC
  146.         XCOOR(NXCOUR+3)=ZPT1+ZD-ZVEC*PVEC
  147.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  148.         GOTO 70
  149. C  Projection sur un plan :
  150.   58    XPOIN=XCOOR(IREF+1)
  151.         YPOIN=XCOOR(IREF+2)
  152.         ZPOIN=XCOOR(IREF+3)
  153.         IF (ICLE.GE.10000) THEN
  154.           XVECS=XVEC-XPOIN
  155.           YVECS=YVEC-YPOIN
  156.           ZVECS=ZVEC-ZPOIN
  157.         ENDIF
  158.         IF (ICLE.LE.0) THEN
  159.           XPX=XP1-XPOIN
  160.           YPX=YP1-YPOIN
  161.           ZPX=ZP1-ZPOIN
  162.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  163.           XPX=XP1-SPS*XVEC
  164.           YPX=YP1-SPS*YVEC
  165.           ZPX=ZP1-SPS*ZVEC
  166.           XVECS=XPX-XPOIN
  167.           YVECS=YPX-YPOIN
  168.           ZVECS=ZPX-ZPOIN
  169.         ENDIF
  170.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  171.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  172.         IF (IERR.NE.0) RETURN
  173.         SVECS=SQRT(SVECS)
  174.         XVECS=XVECS/SVECS
  175.         YVECS=YVECS/SVECS
  176.         ZVECS=ZVECS/SVECS
  177.         DENUM=(XPOIN-XPT1)*XV1+(YPOIN-YPT1)*YV1+(ZPOIN-ZPT1)*ZV1
  178.         DENOM=XVECS*XV1+YVECS*YV1+ZVECS*ZV1
  179.         IF (DENOM.EQ.0.) CALL ERREUR(21)
  180.         IF (IERR.NE.0) RETURN
  181.         RAP=-DENUM/DENOM
  182.         XCOOR(NXCOUR+1)=XPOIN+RAP*XVECS
  183.         XCOOR(NXCOUR+2)=YPOIN+RAP*YVECS
  184.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=ZPOIN+RAP*ZVECS
  185.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  186.         GOTO 70
  187. C  Projection sur une sphere (3D) :
  188.   59    XPOIN=XCOOR(IREF+1)
  189.         YPOIN=XCOOR(IREF+2)
  190.         ZPOIN=XCOOR(IREF+3)
  191.         IF (ICLE.GE.10000) THEN
  192.           XVECS=XVEC-XPOIN
  193.           YVECS=YVEC-YPOIN
  194.           ZVECS=ZVEC-ZPOIN
  195.         ENDIF
  196.         IF (ICLE.LE.0) THEN
  197.           XPX=XP1-XPOIN
  198.           YPX=YP1-YPOIN
  199.           ZPX=ZP1-ZPOIN
  200.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  201.           XPX=XP1-SPS*XVEC
  202.           YPX=YP1-SPS*YVEC
  203.           ZPX=ZP1-SPS*ZVEC
  204.           XVECS=XPX-XPOIN
  205.           YVECS=YPX-YPOIN
  206.           ZVECS=ZPX-ZPOIN
  207.         ENDIF
  208.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  209.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  210.         IF (IERR.NE.0) RETURN
  211.         SVECS=SQRT(SVECS)
  212.         XVECS=XVECS/SVECS
  213.         YVECS=YVECS/SVECS
  214.         ZVECS=ZVECS/SVECS
  215.         SCA=XVECS*(XPT1-XPOIN)+YVECS*(YPT1-YPOIN)+ZVECS*(ZPT1-ZPOIN)
  216.         XV=XVECS*SCA
  217.         YV=YVECS*SCA
  218.         ZV=ZVECS*SCA
  219.         S2=(XPOIN+XV-XPT1)**2+(YPOIN+YV-YPT1)**2+(ZPOIN+ZV-ZPT1)**2
  220.         IF (S2.GT.ANG2) CALL ERREUR(21)
  221.         IF (IERR.NE.0) RETURN
  222.         C=SQRT(ANG2-S2)
  223.         IF (SCA.LT.0.) C=-C
  224.         XCOOR(NXCOUR+1)=XPOIN+XV-C*XVECS
  225.         XCOOR(NXCOUR+2)=YPOIN+YV-C*YVECS
  226.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=ZPOIN+ZV-C*ZVECS
  227.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  228.         GOTO 70
  229. C  Projection sur un cylindre (3D) :
  230.   60    XPOIN=XCOOR(IREF+1)
  231.         YPOIN=XCOOR(IREF+2)
  232.         ZPOIN=XCOOR(IREF+3)
  233.         IF (ICLE.GE.10000) THEN
  234.           XVECS=XVEC-XPOIN
  235.           YVECS=YVEC-YPOIN
  236.           ZVECS=ZVEC-ZPOIN
  237.         ENDIF
  238.         IF (ICLE.LE.0) THEN
  239.           XPX=XP1-XPOIN
  240.           YPX=YP1-YPOIN
  241.           ZPX=ZP1-ZPOIN
  242.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  243.           XPX=XP1-SPS*XVEC
  244.           YPX=YP1-SPS*YVEC
  245.           ZPX=ZP1-SPS*ZVEC
  246.           XVECS=XPX-XPOIN
  247.           YVECS=YPX-YPOIN
  248.           ZVECS=ZPX-ZPOIN
  249.         ENDIF
  250.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  251.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  252.         IF (IERR.NE.0) RETURN
  253.         SVECS=SQRT(SVECS)
  254.         XVECS=XVECS/SVECS
  255.         YVECS=YVECS/SVECS
  256.         ZVECS=ZVECS/SVECS
  257.         XV2=YVECS*ZV1-ZVECS*YV1
  258.         YV2=ZVECS*XV1-XVECS*ZV1
  259.         ZV2=XVECS*YV1-YVECS*XV1
  260.         S2V2=XV2*XV2+YV2*YV2+ZV2*ZV2
  261.         IF (S2V2.EQ.0.) CALL ERREUR(21)
  262.         IF (IERR.NE.0) RETURN
  263.         C2=(XVECS*XV1+YVECS*YV1+ZVECS*ZV1)**2
  264.         IF (C2.EQ.1.) CALL ERREUR(21)
  265.         IF (IERR.NE.0) RETURN
  266.         XV3=XPT1-XPOIN
  267.         YV3=YPT1-YPOIN
  268.         ZV3=ZPT1-ZPOIN
  269.         XV4=YV3*ZV1-ZV3*YV1
  270.         YV4=ZV3*XV1-XV3*ZV1
  271.         ZV4=XV3*YV1-YV3*XV1
  272.         DNUM=(XV4*XVECS+YV4*YVECS+ZV4*ZVECS)**2
  273.         DIS2=DNUM/S2V2
  274.         IF (IIMPI.EQ.1) WRITE (IOIMP,1000) DIS2,ANGLE
  275.  1000     FORMAT (' DISTANCE AU CARRE DES AXES ',G12.5,
  276.      .            'RAYON DU CYLINDRE ',G12.5)
  277.         IF (DIS2.GT.ANG2) CALL ERREUR(21)
  278.         IF (IERR.NE.0) RETURN
  279.         DMU=SQRT((ANG2-DIS2)/(1.-C2))
  280.         DNUM=XV2*XV4+YV2*YV4+ZV2*ZV4
  281.         DLA=DNUM/S2V2
  282.         DMU=SIGN(DMU,DLA)
  283.         IF (IIMPI.NE.0) WRITE (IOIMP,1001) DLA,DMU
  284.  1001     FORMAT(' LAMBDA,MU ',2G13.5)
  285.         XCOOR(NXCOUR+1)=XPOIN+XVECS*(DLA-DMU)
  286.         XCOOR(NXCOUR+2)=YPOIN+YVECS*(DLA-DMU)
  287.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=ZPOIN+ZVECS*(DLA-DMU)
  288.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  289.         GOTO 70
  290. C  Projection sur un cone (3D) :
  291.   61    XPOIN=XCOOR(IREF+1)
  292.         YPOIN=XCOOR(IREF+2)
  293.         ZPOIN=XCOOR(IREF+3)
  294.         IF (ICLE.GE.10000) THEN
  295.           XVECS=XVEC-XPOIN
  296.           YVECS=YVEC-YPOIN
  297.           ZVECS=ZVEC-ZPOIN
  298.         ENDIF
  299.         IF (ICLE.LE.0) THEN
  300.           XPX=XP1-XPOIN
  301.           YPX=YP1-YPOIN
  302.           ZPX=ZP1-ZPOIN
  303.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  304.           XPX=XP1-SPS*XVEC
  305.           YPX=YP1-SPS*YVEC
  306.           ZPX=ZP1-SPS*ZVEC
  307.           XVECS=XPX-XPOIN
  308.           YVECS=YPX-YPOIN
  309.           ZVECS=ZPX-ZPOIN
  310.         ENDIF
  311.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  312.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  313.         IF (IERR.NE.0) RETURN
  314.         SVECS=SQRT(SVECS)
  315.         XVECS=XVECS/SVECS
  316.         YVECS=YVECS/SVECS
  317.         ZVECS=ZVECS/SVECS
  318.         XV2=XPOIN-XPT1
  319.         YV2=YPOIN-YPT1
  320.         ZV2=ZPOIN-ZPT1
  321.         VECV1=XVECS*XV1+YVECS*YV1+ZVECS*ZV1
  322.         VEC2=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  323.         V2V1=XV2*XV1+YV2*YV1+ZV2*ZV1
  324.         VECV2=XVECS*XV2+YVECS*YV2+ZVECS*ZV2
  325.         V22=XV2*XV2+YV2*YV2+ZV2*ZV2
  326.         A=VECV1*VECV1-ANGLE*VEC2
  327.         B=2*(V2V1*VECV1-ANGLE*VECV2)
  328.         C=V2V1*V2V1-ANGLE*V22
  329.         DELTA=B*B-4*A*C
  330.         IF (DELTA.LT.0.) CALL ERREUR(21)
  331.         IF (IERR.NE.0) RETURN
  332.         DEL=SQRT(DELTA)
  333.         X1=(-B+DEL)/(2*A)
  334.         XX=(-B-DEL)/(2*A)
  335.         IF (ABS(X1).LT.ABS(XX)) XX=X1
  336.         XCOOR(NXCOUR+1)=XPOIN+XX*XVECS
  337.         XCOOR(NXCOUR+2)=YPOIN+XX*YVECS
  338.         XCOOR(NXCOUR+3)=ZPOIN+XX*ZVECS
  339.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  340.         GOTO 70
  341. C  Projection sur un tore (3D) :
  342.   62    XPOIN=XCOOR(IREF+1)
  343.         YPOIN=XCOOR(IREF+2)
  344.         ZPOIN=XCOOR(IREF+3)
  345.         IF (ICLE.GE.10000) THEN
  346.           XVECS=XVEC-XPOIN
  347.           YVECS=YVEC-YPOIN
  348.           ZVECS=ZVEC-ZPOIN
  349.         ENDIF
  350.         IF (ICLE.LE.0) THEN
  351.           XPX=XP1-XPOIN
  352.           YPX=YP1-YPOIN
  353.           ZPX=ZP1-ZPOIN
  354.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  355.           XPX=XP1-SPS*XVEC
  356.           YPX=YP1-SPS*YVEC
  357.           ZPX=ZP1-SPS*ZVEC
  358.           XVECS=XPX-XPOIN
  359.           YVECS=YPX-YPOIN
  360.           ZVECS=ZPX-ZPOIN
  361.         ENDIF
  362.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  363.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  364.         IF (IERR.NE.0) RETURN
  365.         SVECS=SQRT(SVECS)
  366.         XVECS=XVECS/SVECS
  367.         YVECS=YVECS/SVECS
  368.         ZVECS=ZVECS/SVECS
  369.         PR2=XV2
  370.         GR2=YV2
  371.         XOP=XPOIN-XPT1
  372.         YOP=YPOIN-YPT1
  373.         ZOP=ZPOIN-ZPT1
  374.         OPV=XOP*XVECS+YOP*YVECS+ZOP*ZVECS
  375.         R2=XOP*XOP+YOP*YOP+ZOP*ZOP-GR2-PR2
  376.         VA=XVECS*XV1+YVECS*YV1+ZVECS*ZV1
  377.         QR2VA2=4*GR2*VA*VA
  378.         OPA=XOP*XV1+YOP*YV1+ZOP*ZV1
  379.         HR2PV=8*GR2*OPA*VA
  380.         R=4*GR2*OPA*OPA-4*PR2*GR2
  381.         RLMD=0
  382. C  Resolution iterative de l'equation du 4eme degre
  383.         DO ITER=1,25
  384.           EXP1=RLMD*(RLMD+2*OPV)+R2
  385.           FDLM=EXP1*EXP1+QR2VA2*RLMD*RLMD+HR2PV*RLMD+R
  386.           FPDLM=4*EXP1*(RLMD+OPV)+QR2VA2*2*RLMD+HR2PV
  387.           IF (FPDLM.EQ.0.) CALL ERREUR(40)
  388.           IF (IERR.NE.0) RETURN
  389.           CORR=FDLM/FPDLM
  390.           IF (IIMPI.NE.0) WRITE(IOIMP,1016) ITER,RLMD,CORR
  391.  1016       FORMAT(' ITER ',I6,' LAMBDA ',G12.5,' CORR ',G12.5)
  392.           RLMD=RLMD-CORR
  393.           IF (RLMD.NE.0.) THEN
  394.             IF (ABS(CORR/RLMD).LT.1E-5) GOTO 66
  395.           ENDIF
  396.         ENDDO
  397.         CALL ERREUR(40)
  398.         RETURN
  399.   66    XCOOR(NXCOUR+1)=XPOIN+RLMD*XVECS
  400.         XCOOR(NXCOUR+2)=YPOIN+RLMD*YVECS
  401.         XCOOR(NXCOUR+3)=ZPOIN+RLMD*ZVECS
  402.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  403.         GOTO 70
  404. C  Projection sur une droite (2D/3D) :
  405.   63    XPOIN=XCOOR(IREF+1)
  406.         YPOIN=XCOOR(IREF+2)
  407.         ZPOIN=0.
  408.         IF (ICLE.GE.10000) THEN
  409.           XVECS=XVEC-XPOIN
  410.           YVECS=YVEC-YPOIN
  411.           ZVECS=0.
  412.         ENDIF
  413.         IF (ICLE.LE.0) THEN
  414.           XPX=XP1-XPOIN
  415.           YPX=YP1-YPOIN
  416.           ZPX=ZP1-ZPOIN
  417.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  418.           XPX=XP1-SPS*XVEC
  419.           YPX=YP1-SPS*YVEC
  420.           ZPX=ZP1-SPS*ZVEC
  421.           XVECS=XPX-XPOIN
  422.           YVECS=YPX-YPOIN
  423.           ZVECS=0.
  424.         ENDIF
  425.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  426.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  427.         IF (IERR.NE.0) RETURN
  428.         SVECS=SQRT(SVECS)
  429.         XVECS=XVECS/SVECS
  430.         YVECS=YVECS/SVECS
  431.         ZVECS=ZVECS/SVECS
  432.         DENUM=(XPOIN-XPT1)*XV1+(YPOIN-YPT1)*YV1
  433.         DENOM=XVECS*XV1+YVECS*YV1+ZVECS*ZV1
  434.         IF (DENOM.EQ.0.) CALL ERREUR(21)
  435.         IF (IERR.NE.0) RETURN
  436.         RAP=-DENUM/DENOM
  437.         XCOOR(NXCOUR+1)=XPOIN+RAP*XVECS
  438.         XCOOR(NXCOUR+2)=YPOIN+RAP*YVECS
  439.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=ZPOIN+RAP*ZVECS
  440.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  441.         GOTO 70
  442. C  Projection sur un cercle (2D/3D) :
  443.   64    XPOIN=XCOOR(IREF+1)
  444.         YPOIN=XCOOR(IREF+2)
  445.         ZPOIN=0.
  446.         IF (ICLE.GE.10000) THEN
  447.           XVECS=XVEC-XPOIN
  448.           YVECS=YVEC-YPOIN
  449.           ZVECS=0.
  450.         ENDIF
  451.         IF (ICLE.LE.0) THEN
  452.           XPX=XP1-XPOIN
  453.           YPX=YP1-YPOIN
  454.           ZPX=ZP1-ZPOIN
  455.           SPS=XPX*XVEC+YPX*YVEC+ZPX*ZVEC
  456.           XPX=XP1-SPS*XVEC
  457.           YPX=YP1-SPS*YVEC
  458.           ZPX=ZP1-SPS*ZVEC
  459.           XVECS=XPX-XPOIN
  460.           YVECS=YPX-YPOIN
  461.           ZVECS=0.
  462.         ENDIF
  463.         SVECS=XVECS*XVECS+YVECS*YVECS+ZVECS*ZVECS
  464.         IF (SVECS.EQ.0.) CALL ERREUR(21)
  465.         IF (IERR.NE.0) RETURN
  466.         SVECS=SQRT(SVECS)
  467.         XVECS=XVECS/SVECS
  468.         YVECS=YVECS/SVECS
  469.         ZVECS=ZVECS/SVECS
  470.         SCA=XVECS*(XPT1-XPOIN)+YVECS*(YPT1-YPOIN)
  471.         XV=XVECS*SCA
  472.         YV=YVECS*SCA
  473.         ZV=ZVECS*SCA
  474.         S2=(XPOIN+XV-XPT1)**2+(YPOIN+YV-YPT1)**2+(ZPOIN+ZV-ZPT1)**2
  475.         IF (S2.GT.ANG2) CALL ERREUR(21)
  476.         IF (IERR.NE.0) RETURN
  477.         C=SQRT(ANG2-S2)
  478.         IF (SCA.LT.0.) C=-C
  479.         XCOOR(NXCOUR+1)=XPOIN+XV-C*XVECS
  480.         XCOOR(NXCOUR+2)=YPOIN+YV-C*YVECS
  481.         IF (IDIM.GE.3) XCOOR(NXCOUR+3)=ZPOIN+ZV-C*ZVECS
  482.         XCOOR(NXCOUR+idimp1)=XCOOR(IREF+idimp1)
  483.         GOTO 70
  484. C  Stockage du point image cree dans XCOOR et dans ICPR
  485. C  On remplit le maillage IPT2
  486.   70    NXCOUR=NXCOUR+idimp1
  487.         IPT2.NUM(i,j)=NXCOUR/idimp1
  488.         ICPR(IPT1.NUM(i,j))=IPT2.NUM(i,j)
  489.       ELSE
  490. C  On recupere le noeud image dans ICPR et on remplit IPT2
  491.         IPT2.NUM(i,j)=ICPR(IPT1.NUM(i,j))
  492.       ENDIF
  493.   11  CONTINUE
  494.   10  CONTINUE
  495. C  Fin de la boucle sur les noeuds de IPT1
  496. C  On a cree IPT2 maillage transforme de IPT2 (elements,noeuds)
  497.  
  498.       NBPTS=NXCOUR/idimp1
  499.       SEGADJ MCOORD
  500.  
  501.       RETURN
  502.       END
  503.  
  504.  
  505.  
  506.  
  507.  
  508.  
  509.  
  510.  
  511.  
  512.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales