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