Esope source files

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