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

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