Télécharger la plaquette Cast3M


fr en

Télécharger pcyli.eso

Retour à la liste

Numérotation des lignes : 

pcyli

  1. C PCYLI     SOURCE    PV090527  23/10/25    21:15:05     11773          
  2. C    CE SOUS-PROGRAMME RAMENNE UN CYLINDRE SUR SES COORDONNEES PROPRES
  3. C
  4.       SUBROUTINE PCYLI(IOP,FER,XPROJ,NDEB,NUMNP,IP1,IP2,tcval,isens)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. -INC SMCOORD
  8.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11.       real*8 tcval(*)
  12.       SEGMENT/FER/(NFI(ITT),MAI(IPP),ITOUR)
  13.       SEGMENT XPROJ(3,IMAX)
  14. *      tcval  1   2     3     4    5    6
  15. *      SAVE XORIG,YORIG,ZORIG,XAXE,YAXE,ZAXE
  16. * tcval     7  8  9
  17. *      SAVE XP1,YP1,ZP1
  18. * tcval           10
  19. *      SAVE ISENS,RAYON
  20.       IF (IOP.EQ.2) GOTO 100
  21.       IMCT=MAI(ITOUR+1)
  22.       INCT=MAI(1)+1
  23.       IMAX=(IMCT**2)+10
  24.       CALL LIRENT(IMAX,0,IRETOU)
  25.       IF (IRETOU.NE.0) IMAX=MAX(1,IMAX)
  26.       NDEB=IMCT+1
  27.       SEGINI XPROJ
  28.       SEGACT MCOORD
  29. C   AXE DU CYLINDRE
  30.       IREF=IP1*4-3
  31.       XP1=XCOOR(IREF)
  32.       YP1=XCOOR(IREF+1)
  33.       ZP1=XCOOR(IREF+2)
  34.       tcval(7)=xp1
  35.       tcval(8)=yp1
  36.       tcval(9)=zp1
  37.       IREF=IP2*4-3
  38.       XP2=XCOOR(IREF)
  39.       YP2=XCOOR(IREF+1)
  40.       ZP2=XCOOR(IREF+2)
  41.       XAXE=XP2-XP1
  42.       YAXE=YP2-YP1
  43.       ZAXE=ZP2-ZP1
  44.       DAXE=SQRT(XAXE**2+YAXE**2+ZAXE**2)
  45.       IF (DAXE.EQ.0.) CALL ERREUR(21)
  46.       IF (IERR.NE.0.) RETURN
  47.       XAXE=XAXE/DAXE
  48.       YAXE=YAXE/DAXE
  49.       ZAXE=ZAXE/DAXE
  50.       tcval(4)=xaxe
  51.       tcval(5)=yaxe
  52.       tcval(6)=zaxe
  53. C  DEROULONS LE CYLINDRE
  54.       IREF=4*NFI(IMCT)-3
  55.       XV1=XCOOR(IREF)-XP1
  56.       YV1=XCOOR(IREF+1)-YP1
  57.       ZV1=XCOOR(IREF+2)-ZP1
  58.       XI=XV1*XAXE+YV1*YAXE+ZV1*ZAXE
  59.       XV1=XV1-XI*XAXE
  60.       YV1=YV1-XI*YAXE
  61.       ZV1=ZV1-XI*ZAXE
  62.       IF (XV1**2+YV1**2+ZV1**2.EQ.0.) CALL ERREUR(21)
  63.       IF (IERR.NE.0) RETURN
  64.       XORIG=XV1
  65.       YORIG=YV1
  66.       ZORIG=ZV1
  67.       tcval(1)=xorig
  68.       tcval(2)=yorig
  69.       tcval(3)=zorig
  70.       RAYON=0
  71.       COT=0
  72.       DO 1 I=INCT,max(IMCT,mai(itour+2))
  73.       II=NFI(I)
  74.       IREF=4*II-3
  75.       XV2=XCOOR(IREF)-XP1
  76.       YV2=XCOOR(IREF+1)-YP1
  77.       ZV2=XCOOR(IREF+2)-ZP1
  78.       XPROJ(1,I)=XV2*XAXE+YV2*YAXE+ZV2*ZAXE
  79.       XPROJ(3,I)=XCOOR(IREF+3)
  80.       XI=XPROJ(1,I)
  81.       XV2=XV2-XI*XAXE
  82.       YV2=YV2-XI*YAXE
  83.       ZV2=ZV2-XI*ZAXE
  84.       R=XV2**2+YV2**2+ZV2**2
  85.       IF (R.EQ.0..and.i.le.imct) CALL ERREUR(21)
  86.       IF (IERR.NE.0) RETURN
  87.       if (i.le.imct) RAYON=RAYON+R
  88.       ANG=ATAN2(XAXE*(YV1*ZV2-YV2*ZV1)+YAXE*(ZV1*XV2-ZV2*XV1)+
  89.      #  ZAXE*(XV1*YV2-XV2*YV1),XV1*XV2+YV1*YV2+ZV1*ZV2)
  90.       COT=COT+ANG
  91.       XPROJ(2,I)=COT
  92.       XV1=XV2
  93.       YV1=YV2
  94.       ZV1=ZV2
  95.    1  CONTINUE
  96.       RAYON2=RAYON/(IMCT-INCT+1)
  97.       RAYON=SQRT(RAYON2)
  98.       tcval(10)=rayon
  99.       DO 2 I=INCT,max(IMCT,mai(itour+2))
  100.       XPROJ(2,I)=XPROJ(2,I)*RAYON
  101.       II=NFI(I)
  102.       NFI(I)=I
  103.       IREF=4*II-3
  104.       XV=XCOOR(IREF)-XP1
  105.       YV=XCOOR(IREF+1)-YP1
  106.       ZV=XCOOR(IREF+2)-ZP1
  107.       SCAL=XV*XAXE+YV*YAXE+ZV*ZAXE
  108.       XV=XV-SCAL*XAXE
  109.       YV=YV-SCAL*YAXE
  110.       ZV=ZV-SCAL*ZAXE
  111.       RAY2=XV**2+YV**2+ZV**2
  112.       RAP=RAY2/RAYON2
  113.       IF ((RAP.GT.1.02.OR.RAP.LT.0.98).and.i.le.imct) CALL ERREUR(1142)
  114.    2  CONTINUE
  115. C  IL FAUT TOURNER DANS LE BON SENS
  116.       SURF=0
  117.       DO   IT=1,ITOUR
  118.       II1=MAI(IT-1+1)+1
  119.       II2=MAI(IT+1)
  120.       XV1=XPROJ(1,II2)
  121.       YV1=XPROJ(2,II2)
  122.       DO   I=II1,II2
  123.        XV2=XPROJ(1,I)
  124.        YV2=XPROJ(2,I)
  125.        IF (XPROJ(3,I).EQ.0.) XPROJ(3,I)=SQRT((XV2-XV1)**2+(YV2-YV1)**2)
  126.        SURF=SURF+XV1*YV2-XV2*YV1
  127.        XV1=XV2
  128.        YV1=YV2
  129.       enddo    
  130.       enddo    
  131.       ISENS=1
  132.       IF (SURF.GT.0.) GOTO 5
  133.       ISENS=-1
  134.       DO 4 I=INCT,max(IMCT,mai(itour+2))
  135.       XPROJ(1,I)=-XPROJ(1,I)
  136.    4  CONTINUE
  137.    5  CONTINUE
  138.       RETURN
  139. C   TRANSFORMATION INVERSE
  140.  100  CONTINUE
  141.       SEGACT MCOORD*mod
  142.       xorig=tcval(1)
  143.       yorig=tcval(2)
  144.       zorig=tcval(3)
  145.       xaxe=tcval(4)
  146.       yaxe=tcval(5)
  147.       zaxe=tcval(6)
  148.       xp1=tcval(7)
  149.       yp1=tcval(8)
  150.       zp1=tcval(9)
  151.       rayon=tcval(10)
  152.       XREP1=XORIG
  153.       YREP1=YORIG
  154.       ZREP1=ZORIG
  155.       XREP2=YAXE*ZREP1-ZAXE*YREP1
  156.       YREP2=ZAXE*XREP1-XAXE*ZREP1
  157.       ZREP2=XAXE*YREP1-YAXE*XREP1
  158.       IF (NUMNP.LT.NDEB) GOTO 102
  159.       NBPTA=nbpts
  160.       NBPTS=NBPTA+NUMNP-NDEB+1
  161.       SEGADJ MCOORD
  162.       DO 101 I=NDEB,NUMNP
  163.       Z=XPROJ(1,I)*ISENS
  164.       ANG=XPROJ(2,I)/RAYON
  165.       SI=SIN(ANG)
  166.       CO=COS(ANG)
  167.       XCOOR(NBPTA*4+1)=XREP1*CO+XREP2*SI+Z*XAXE+XP1
  168.       XCOOR(NBPTA*4+2)=YREP1*CO+YREP2*SI+Z*YAXE+YP1
  169.       XCOOR(NBPTA*4+3)=ZREP1*CO+ZREP2*SI+Z*ZAXE+ZP1
  170.       XCOOR(NBPTA*4+4)=XPROJ(3,I)
  171.       NBPTA=NBPTA+1
  172.  101  CONTINUE
  173.  102  CONTINUE
  174.       SEGSUP XPROJ
  175.       RETURN
  176.       END
  177.  
  178.  
  179.  
  180.  
  181.  

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