Télécharger proobj.eso

Retour à la liste

Numérotation des lignes :

  1. C PROOBJ SOURCE CHAT 05/01/13 02:34:30 5004
  2. C CE SOUS-PROGRAMME PREPARE LA PROJECTION D'UN OBJET SUR UNE
  3. C SURFACE :
  4. C PLAN P1 P2 P3
  5. C SPHE C P
  6. C CYLI C1 C2 P
  7. C CONI C C1 P
  8. C TORI C A Cs P
  9. C NOUVELLE POSSIBILITE EN 2D NOVEMBRE 1986
  10. C DROI P1 P2
  11. C CERCLE P1
  12. C
  13. C JANVIER 1987 INTRODUCTION DE LA PROJECTION CONIQUE
  14. C
  15. C SEPTEMBRE 1996 PROJECTION D'UN OBJET MAILLAGE SUR UN OBJET
  16. C MAILLAGE.
  17. SUBROUTINE PROOBJ
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8 (A-H,O-Z)
  20. -INC CCOPTIO
  21. -INC SMCOORD
  22. -INC SMELEME
  23. COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
  24. # ZVEC,ANGLE,ICLE
  25. CHARACTER*4 MCLE(7),MTYPP(2)
  26. DATA MTYPP/'CYLI','CONI'/
  27. DATA MCLE/'PLAN','SPHE','CYLI','CONI','TORI','DROI','CERC'/
  28. SEGACT MCOORD
  29. MELEME=0
  30. CALL LIROBJ('MAILLAGE',MELEME,0,IRETOU)
  31. IF (IRETOU.EQ.1) GOTO 1
  32. C C'EST UN POINT QU'ON PROJETTE
  33. CALL LIROBJ('POINT ',IPOIN,1,IRETOU)
  34. IF (IERR.NE.0) RETURN
  35. 1 CONTINUE
  36. * CONIQUE OU CYLINDRIQUE
  37. CALL LIRMOT(MTYPP,2,IYYT,0)
  38. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  39. IF (IERR.NE.0) RETURN
  40. CALL LIROBJ('MAILLAGE',IPPP,0,IRETO)
  41. IF (IYYT.EQ.1) THEN
  42. IF(IRETO.NE.0) THEN
  43. CALL PROOB1(MELEME,IPPP,IP1)
  44. RETURN
  45. ENDIF
  46. ENDIF
  47. IF (IYYT.EQ.2) THEN
  48. IF(IRETO.NE.0) THEN
  49. CALL PROOB4(MELEME,IPPP,IP1)
  50. RETURN
  51. ENDIF
  52. ENDIF
  53. SEGACT MCOORD
  54. IREF=(IDIM+1)*(IP1-1)
  55. XVEC=XCOOR(IREF+1)
  56. YVEC=XCOOR(IREF+2)
  57. ZVEC=XCOOR(IREF+3)
  58. IF (IDIM.EQ.2) ZVEC=0.
  59. IALIR=0
  60. IF (IYYT.EQ.0) IALIR=1
  61. CALL LIRMOT(MCLE,7,IVAL,IALIR)
  62. IF (IVAL.EQ.0) THEN
  63. IVAL=IYYT+2
  64. IYYT=0
  65. ENDIF
  66. IF (IERR.NE.0) RETURN
  67. IF (IDIM.EQ.2.AND.IVAL.LE.5) CALL ERREUR(34)
  68. IF (IDIM.EQ.3.AND.IVAL.GE.6) CALL ERREUR(34)
  69. IF (IERR.NE.0) RETURN
  70. ICLE=IVAL+7
  71. GOTO (10,20,30,40,50,60,70),IVAL
  72. 10 CONTINUE
  73. C PLAN ON LIT TROIS POINTS
  74. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  75. CALL LIROBJ('POINT ',IP2,1,IRETOU)
  76. CALL LIROBJ('POINT ',IP3,1,IRETOU)
  77. IF (IERR.NE.0) RETURN
  78. IREF=(IDIM+1)*(IP1-1)
  79. XPT1=XCOOR(IREF+1)
  80. YPT1=XCOOR(IREF+2)
  81. ZPT1=XCOOR(IREF+3)
  82. IREF=(IDIM+1)*(IP2-1)
  83. XV2=XCOOR(IREF+1)-XPT1
  84. YV2=XCOOR(IREF+2)-YPT1
  85. ZV2=XCOOR(IREF+3)-ZPT1
  86. IREF=(IDIM+1)*(IP3-1)
  87. XV3=XCOOR(IREF+1)-XPT1
  88. YV3=XCOOR(IREF+2)-YPT1
  89. ZV3=XCOOR(IREF+3)-ZPT1
  90. C ON GARDE LE VECTEUR NORMAL NORMALISE
  91. XV1=YV2*ZV3-ZV2*YV3
  92. YV1=ZV2*XV3-XV2*ZV3
  93. ZV1=XV2*YV3-YV2*XV3
  94. SV1=SQRT(XV1**2+YV1**2+ZV1**2)
  95. IF (SV1.EQ.0.) CALL ERREUR(21)
  96. IF (IERR.NE.0) RETURN
  97. XV1=XV1/SV1
  98. YV1=YV1/SV1
  99. ZV1=ZV1/SV1
  100. GOTO 100
  101. 20 CONTINUE
  102. C SPHERE ON LIT LE CENTRE ET UN POINT
  103. CALL LIROBJ('POINT ',IPCEN,1,IRETOU)
  104. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  105. IF (IERR.NE.0) RETURN
  106. IREF=(IPCEN-1)*(IDIM+1)
  107. XPT1=XCOOR(IREF+1)
  108. YPT1=XCOOR(IREF+2)
  109. ZPT1=XCOOR(IREF+3)
  110. IREF=(IP1-1)*(IDIM+1)
  111. XV=XCOOR(IREF+1)-XPT1
  112. YV=XCOOR(IREF+2)-YPT1
  113. ZV=XCOOR(IREF+3)-ZPT1
  114. ANGLE=SQRT(XV**2+YV**2+ZV**2)
  115. IF (ANGLE.EQ.0.) CALL ERREUR(21)
  116. IF (IERR.NE.0) RETURN
  117. GOTO 100
  118. 30 CONTINUE
  119. C CYLINDRE ON LIT DEUX POINTS DE L'AXE ET UN POINT DU CYLINDRE
  120. CALL LIROBJ('POINT ',IPOIN1,1,IRETOU)
  121. CALL LIROBJ('POINT ',IPOIN2,1,IRETOU)
  122. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  123. IF (IERR.NE.0) RETURN
  124. IREF=(IDIM+1)*(IPOIN1-1)
  125. XPT1=XCOOR(IREF+1)
  126. YPT1=XCOOR(IREF+2)
  127. ZPT1=XCOOR(IREF+3)
  128. IREF=(IDIM+1)*(IPOIN2-1)
  129. XV1=XCOOR(IREF+1)-XPT1
  130. YV1=XCOOR(IREF+2)-YPT1
  131. ZV1=XCOOR(IREF+3)-ZPT1
  132. S=SQRT(XV1**2+YV1**2+ZV1**2)
  133. IF (S.EQ.0.) CALL ERREUR(21)
  134. IF (IERR.NE.0) RETURN
  135. XV1=XV1/S
  136. YV1=YV1/S
  137. ZV1=ZV1/S
  138. IREF=(IDIM+1)*(IP1-1)
  139. XV2=XCOOR(IREF+1)-XPT1
  140. YV2=XCOOR(IREF+2)-YPT1
  141. ZV2=XCOOR(IREF+3)-ZPT1
  142. XV3=YV1*ZV2-ZV1*YV2
  143. YV3=ZV1*XV2-XV1*ZV2
  144. ZV3=XV1*YV2-YV1*XV2
  145. ANGLE=SQRT(XV3**2+YV3**2+ZV3**2)
  146. C RAYON DU CYLINDRE
  147. IF (ANGLE.EQ.0) CALL ERREUR(21)
  148. IF (IERR.NE.0) RETURN
  149. GOTO 100
  150. 40 CONTINUE
  151. C CONE ON LIT LE SOMMET UN POINT DE L'AXE ET UN POINT DU CONE
  152. CALL LIROBJ('POINT ',IPT1,1,IRETOU)
  153. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  154. CALL LIROBJ('POINT ',IP2,1,IRETOU)
  155. IF (IERR.NE.0) RETURN
  156. IREF=(IDIM+1)*(IPT1-1)
  157. XPT1=XCOOR(IREF+1)
  158. YPT1=XCOOR(IREF+2)
  159. ZPT1=XCOOR(IREF+3)
  160. IREF=(IDIM+1)*(IP1-1)
  161. XV1=XCOOR(IREF+1)-XPT1
  162. YV1=XCOOR(IREF+2)-YPT1
  163. ZV1=XCOOR(IREF+3)-ZPT1
  164. SV1=SQRT(XV1**2+YV1**2+ZV1**2)
  165. IF (SV1.EQ.0.) CALL ERREUR(21)
  166. IF (IERR.NE.0) RETURN
  167. XV1=XV1/SV1
  168. YV1=YV1/SV1
  169. ZV1=ZV1/SV1
  170. IREF=(IDIM+1)*(IP2-1)
  171. XV2=XCOOR(IREF+1)-XPT1
  172. YV2=XCOOR(IREF+2)-YPT1
  173. ZV2=XCOOR(IREF+3)-ZPT1
  174. SV2=SQRT(XV2**2+YV2**2+ZV2**2)
  175. IF (SV2.EQ.0.) CALL ERREUR(21)
  176. IF (IERR.NE.0) RETURN
  177. XV2=XV2/SV2
  178. YV2=YV2/SV2
  179. ZV2=ZV2/SV2
  180. ANGLE=(XV1*XV2+YV1*YV2+ZV1*ZV2)**2
  181. IF (IIMPI.NE.0) WRITE (IOIMP,1012) ANGLE
  182. 1012 FORMAT(' COS **2 DE ANGLE AU SOMMET ',G12.5)
  183. GOTO 100
  184. 50 CONTINUE
  185. C TORE ON LIT LE CENTRE UN POINT DE L'AXE UN CENTRE SECONDAIRE ET
  186. C UN POINT
  187. CALL LIROBJ('POINT ',IPT1,1,IRETOU)
  188. CALL LIROBJ('POINT ',IPAX,1,IRETOU)
  189. CALL LIROBJ('POINT ',IPCS,1,IRETOU)
  190. CALL LIROBJ('POINT ',IP1 ,1,IRETOU)
  191. IF (IERR.NE.0) RETURN
  192. IREF=(IDIM+1)*(IPT1-1)
  193. XPT1=XCOOR(IREF+1)
  194. YPT1=XCOOR(IREF+2)
  195. ZPT1=XCOOR(IREF+3)
  196. IREF=(IDIM+1)*(IPAX-1)
  197. XV1=XCOOR(IREF+1)-XPT1
  198. YV1=XCOOR(IREF+2)-YPT1
  199. ZV1=XCOOR(IREF+3)-ZPT1
  200. SV1=XV1**2+YV1**2+ZV1**2
  201. IF (SV1.EQ.0.) CALL ERREUR(21)
  202. IF (IERR.NE.0) RETURN
  203. SV1=SQRT(SV1)
  204. XV1=XV1/SV1
  205. YV1=YV1/SV1
  206. ZV1=ZV1/SV1
  207. IREF=(IDIM+1)*(IPCS-1)
  208. XV2=XCOOR(IREF+1)-XPT1
  209. YV2=XCOOR(IREF+2)-YPT1
  210. ZV2=XCOOR(IREF+3)-ZPT1
  211. SCA=XV2*XV1+YV2*YV1+ZV2*ZV1
  212. XPT1=XPT1+SCA*XV1
  213. YPT1=YPT1+SCA*YV1
  214. ZPT1=ZPT1+SCA*ZV1
  215. XV2=XV2-SCA*XV1
  216. YV2=YV2-SCA*YV1
  217. ZV2=ZV2-SCA*ZV1
  218. GR2=XV2**2+YV2**2+ZV2**2
  219. IF (GR2.EQ.0.) CALL ERREUR(21)
  220. IF (IERR.NE.0) RETURN
  221. IREF=(IDIM+1)*(IP1-1)
  222. XV2=XCOOR(IREF+1)-XPT1
  223. YV2=XCOOR(IREF+2)-YPT1
  224. ZV2=XCOOR(IREF+3)-ZPT1
  225. SCA=XV2*XV1+YV2*YV1+ZV2*ZV1
  226. XC=XV2-SCA*XV1
  227. YC=YV2-SCA*YV1
  228. ZC=ZV2-SCA*ZV1
  229. SC=XC**2+YC**2+ZC**2
  230. IF (SC.EQ.0.) CALL ERREUR(21)
  231. IF (IERR.NE.0) RETURN
  232. RAP=SQRT(GR2/SC)
  233. XC=XC*RAP
  234. YC=YC*RAP
  235. ZC=ZC*RAP
  236. PR2=(XV2-XC)**2+(YV2-YC)**2+(ZV2-ZC)**2
  237. IF (PR2.EQ.0.) CALL ERREUR(21)
  238. IF (IERR.NE.0) RETURN
  239. XV2=PR2
  240. YV2=GR2
  241. IF (IIMPI.NE.0) WRITE (IOIMP,1015) XV2,YV2,XPT1,YPT1,ZPT1,
  242. # XV1,YV1,ZV1
  243. 1015 FORMAT(' CARRE PETIT RAYON ',G12.5,
  244. # ' CARRE GRAND RAYON ',G12.5,/,' CENTRE ',3G13.5,' AXE ',
  245. # 3G12.5)
  246. GOTO 100
  247. 60 CONTINUE
  248. C DROITE ON LIT DEUX POINTS
  249. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  250. CALL LIROBJ('POINT ',IP2,1,IRETOU)
  251. IF (IERR.NE.0) RETURN
  252. IREF=(IDIM+1)*(IP1-1)
  253. XPT1=XCOOR(IREF+1)
  254. YPT1=XCOOR(IREF+2)
  255. ZPT1=0.
  256. IREF=(IDIM+1)*(IP2-1)
  257. XV2=XCOOR(IREF+1)-XPT1
  258. YV2=XCOOR(IREF+2)-YPT1
  259. ZV2=0.
  260. XV3=0.
  261. YV3=0.
  262. ZV3=1.
  263. C ON GARDE LE VECTEUR NORMAL NORMALISE
  264. XV1=YV2*ZV3-ZV2*YV3
  265. YV1=ZV2*XV3-XV2*ZV3
  266. ZV1=XV2*YV3-YV2*XV3
  267. SV1=SQRT(XV1**2+YV1**2+ZV1**2)
  268. IF (SV1.EQ.0.) CALL ERREUR(21)
  269. IF (IERR.NE.0) RETURN
  270. XV1=XV1/SV1
  271. YV1=YV1/SV1
  272. ZV1=ZV1/SV1
  273. GOTO 100
  274. 70 CONTINUE
  275. C CERCLE ON LIT LE CENTRE ET UN POINT
  276. CALL LIROBJ('POINT ',IPCEN,1,IRETOU)
  277. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  278. IF (IERR.NE.0) RETURN
  279. IREF=(IPCEN-1)*(IDIM+1)
  280. XPT1=XCOOR(IREF+1)
  281. YPT1=XCOOR(IREF+2)
  282. ZPT1=0.
  283. IREF=(IP1-1)*(IDIM+1)
  284. XV=XCOOR(IREF+1)-XPT1
  285. YV=XCOOR(IREF+2)-YPT1
  286. ZV=0.
  287. ANGLE=SQRT(XV**2+YV**2+ZV**2)
  288. IF (ANGLE.EQ.0.) CALL ERREUR(21)
  289. IF (IERR.NE.0) RETURN
  290. GOTO 100
  291. 100 CONTINUE
  292. IF (MELEME.EQ.0) GOTO 101
  293. IF (IYYT.EQ.2) THEN
  294. IVAL=IVAL+10000
  295. ICLE=ICLE+10000
  296. ENDIF
  297. CALL INTOPE(MELEME)
  298. RETURN
  299. 101 CONTINUE
  300. IREF=(IDIM+1)*(IPOIN-1)
  301. XPOIN=XCOOR(IREF+1)
  302. YPOIN=XCOOR(IREF+2)
  303. ZPOIN=XCOOR(IREF+3)
  304. TPOIN=XCOOR(IREF+4)
  305. IF (IDIM.EQ.2) ZPOIN=0
  306. IF (IDIM.EQ.2) TPOIN=XCOOR(IREF+3)
  307. IF (IYYT.EQ.2) THEN
  308. XVEC=XVEC-XPOIN
  309. YVEC=YVEC-YPOIN
  310. ZVEC=ZVEC-ZPOIN
  311. IF (IDIM.EQ.2) ZVEC=0.
  312. ENDIF
  313. SVEC=SQRT(XVEC**2+YVEC**2+ZVEC**2)
  314. IF (SVEC.EQ.0.) CALL ERREUR(21)
  315. IF (IERR.NE.0) RETURN
  316. XVEC=XVEC/SVEC
  317. YVEC=YVEC/SVEC
  318. ZVEC=ZVEC/SVEC
  319. GOTO (110,120,130,140,150,160,170),IVAL
  320. 110 CONTINUE
  321. XV=XPOIN-XPT1
  322. YV=YPOIN-YPT1
  323. ZV=ZPOIN-ZPT1
  324. DENUM=XV*XV1+YV*YV1+ZV*ZV1
  325. DENOM=XVEC*XV1+YVEC*YV1+ZVEC*ZV1
  326. IF (DENOM.EQ.0.) CALL ERREUR(21)
  327. IF (IERR.NE.0) RETURN
  328. RAP=-DENUM/DENOM
  329. XPOIN=XPOIN+RAP*XVEC
  330. YPOIN=YPOIN+RAP*YVEC
  331. ZPOIN=ZPOIN+RAP*ZVEC
  332. GOTO 200
  333. 120 CONTINUE
  334. XV=XPT1-XPOIN
  335. YV=YPT1-YPOIN
  336. ZV=ZPT1-ZPOIN
  337. SCA=XVEC*XV+YVEC*YV+ZVEC*ZV
  338. XV=XVEC*SCA
  339. YV=YVEC*SCA
  340. ZV=ZVEC*SCA
  341. S2=(XPOIN+XV-XPT1)**2+(YPOIN+YV-YPT1)**2+(ZPOIN+ZV-ZPT1)**2
  342. IF (S2.GT.ANGLE**2) CALL ERREUR(21)
  343. IF (IERR.NE.0) RETURN
  344. C=SQRT(ANGLE**2-S2)
  345. IF (SCA.LT.0.) C=-C
  346. XPOIN=XPOIN+XV-C*XVEC
  347. YPOIN=YPOIN+YV-C*YVEC
  348. ZPOIN=ZPOIN+ZV-C*ZVEC
  349. GOTO 200
  350. 130 CONTINUE
  351. C V2 = VEC VECT V1
  352. XV2=YVEC*ZV1-ZVEC*YV1
  353. YV2=ZVEC*XV1-XVEC*ZV1
  354. ZV2=XVEC*YV1-YVEC*XV1
  355. S2V2=XV2**2+YV2**2+ZV2**2
  356. IF (S2V2.EQ.0.) CALL ERREUR(21)
  357. IF (IERR.NE.0) RETURN
  358. C2=(XVEC*XV1+YVEC*YV1+ZVEC*ZV1)**2
  359. IF (C2.EQ.1.) CALL ERREUR(21)
  360. IF (IERR.NE.0) RETURN
  361. C V3= POIN PT1
  362. XV3=XPT1-XPOIN
  363. YV3=YPT1-YPOIN
  364. ZV3=ZPT1-ZPOIN
  365. XV4=YV3*ZV1-ZV3*YV1
  366. YV4=ZV3*XV1-XV3*ZV1
  367. ZV4=XV3*YV1-YV3*XV1
  368. DNUM=(XV4*XVEC+YV4*YVEC+ZV4*ZVEC)**2
  369. DIS2=DNUM/S2V2
  370. IF (IIMPI.NE.0) WRITE (IOIMP,1000) DIS2,ANGLE
  371. 1000 FORMAT (' DISTANCE AU CARRE DES AXES ',G12.5,
  372. # 'RAYON DU CYLINDRE ',G12.5)
  373. IF (DIS2.GT.ANGLE**2) CALL ERREUR(21)
  374. IF (IERR.NE.0) RETURN
  375. DMU=SQRT((ANGLE**2-DIS2)/(1.-C2))
  376. DNUM=XV2*XV4+YV2*YV4+ZV2*ZV4
  377. DLA=DNUM/S2V2
  378. DMU=SIGN(DMU,DLA)
  379. IF (IIMPI.NE.0) WRITE (IOIMP,1001) DLA,DMU
  380. 1001 FORMAT(' LAMBDA,MU ',2G13.5)
  381. XPOIN=XPOIN+XVEC*(DLA-DMU)
  382. YPOIN=YPOIN+YVEC*(DLA-DMU)
  383. ZPOIN=ZPOIN+ZVEC*(DLA-DMU)
  384. GOTO 200
  385. 140 CONTINUE
  386. XV2=XPOIN-XPT1
  387. YV2=YPOIN-YPT1
  388. ZV2=ZPOIN-ZPT1
  389. VECV1=XVEC*XV1+YVEC*YV1+ZVEC*ZV1
  390. VEC2=XVEC**2+YVEC**2+ZVEC**2
  391. V2V1=XV2*XV1+YV2*YV1+ZV2*ZV1
  392. VECV2=XVEC*XV2+YVEC*YV2+ZVEC*ZV2
  393. V22=XV2**2+YV2**2+ZV2**2
  394. A=VECV1**2-ANGLE*VEC2
  395. B=2*(V2V1*VECV1-ANGLE*VECV2)
  396. C=V2V1**2-ANGLE*V22
  397. DELTA=B**2-4*A*C
  398. IF (DELTA.LT.0.) CALL ERREUR(21)
  399. IF (IERR.NE.0) RETURN
  400. DEL=SQRT(DELTA)
  401. X1=(-B+DEL)/(2*A)
  402. X2=(-B-DEL)/(2*A)
  403. X=X2
  404. IF (ABS(X1).LT.ABS(X2)) X=X1
  405. XPOIN=XPOIN+X*XVEC
  406. YPOIN=YPOIN+X*YVEC
  407. ZPOIN=ZPOIN+X*ZVEC
  408. GOTO 200
  409. 150 CONTINUE
  410. PR2=XV2
  411. GR2=YV2
  412. XOP=XPOIN-XPT1
  413. YOP=YPOIN-YPT1
  414. ZOP=ZPOIN-ZPT1
  415. OPV=XOP*XVEC+YOP*YVEC+ZOP*ZVEC
  416. R2=XOP**2+YOP**2+ZOP**2-GR2-PR2
  417. VA=XVEC*XV1+YVEC*YV1+ZVEC*ZV1
  418. QR2VA2=4*GR2*VA**2
  419. OPA=XOP*XV1+YOP*YV1+ZOP*ZV1
  420. HR2PV=8*GR2*OPA*VA
  421. R=4*GR2*OPA**2-4*PR2*GR2
  422. RLMD=0
  423. C RESOLUTION DE L'EQUATION DU 4EME DEGRE PAR ITERATION
  424. DO 151 ITER=1,25
  425. EXP1=RLMD*(RLMD+2*OPV)+R2
  426. FDLM=EXP1**2+QR2VA2*RLMD**2+HR2PV*RLMD+R
  427. FPDLM=4*EXP1*(RLMD+OPV)+QR2VA2*2*RLMD+HR2PV
  428. IF (FPDLM.EQ.0.) CALL ERREUR(40)
  429. IF (IERR.NE.0) RETURN
  430. CORR=FDLM/FPDLM
  431. IF (IIMPI.NE.0) WRITE(IOIMP,1016) ITER,RLMD,CORR
  432. 1016 FORMAT(' ITER ',I6,' LAMBDA ',G12.5,' CORR ',G12.5)
  433. RLMD=RLMD-CORR
  434. IF (RLMD.EQ.0.) GOTO 151
  435. IF (ABS(CORR/RLMD).LT.1E-5) GOTO 152
  436. 151 CONTINUE
  437. CALL ERREUR(40)
  438. RETURN
  439. 152 CONTINUE
  440. XPOIN=XPOIN+RLMD*XVEC
  441. YPOIN=YPOIN+RLMD*YVEC
  442. ZPOIN=ZPOIN+RLMD*ZVEC
  443. GOTO 200
  444. 160 CONTINUE
  445. XV=XPOIN-XPT1
  446. YV=YPOIN-YPT1
  447. ZV=ZPOIN-ZPT1
  448. DENUM=XV*XV1+YV*YV1+ZV*ZV1
  449. DENOM=XVEC*XV1+YVEC*YV1+ZVEC*ZV1
  450. IF (DENOM.EQ.0.) CALL ERREUR(21)
  451. IF (IERR.NE.0) RETURN
  452. RAP=-DENUM/DENOM
  453. XPOIN=XPOIN+RAP*XVEC
  454. YPOIN=YPOIN+RAP*YVEC
  455. ZPOIN=ZPOIN+RAP*ZVEC
  456. GOTO 200
  457. 170 CONTINUE
  458. XV=XPT1-XPOIN
  459. YV=YPT1-YPOIN
  460. ZV=ZPT1-ZPOIN
  461. SCA=XVEC*XV+YVEC*YV+ZVEC*ZV
  462. XV=XVEC*SCA
  463. YV=YVEC*SCA
  464. ZV=ZVEC*SCA
  465. S2=(XPOIN+XV-XPT1)**2+(YPOIN+YV-YPT1)**2+(ZPOIN+ZV-ZPT1)**2
  466. IF (S2.GT.ANGLE**2) CALL ERREUR(21)
  467. IF (IERR.NE.0) RETURN
  468. C=SQRT(ANGLE**2-S2)
  469. IF (SCA.LT.0.) C=-C
  470. XPOIN=XPOIN+XV-C*XVEC
  471. YPOIN=YPOIN+YV-C*YVEC
  472. ZPOIN=ZPOIN+ZV-C*ZVEC
  473. GOTO 200
  474. 200 CONTINUE
  475. NBPTS=XCOOR(/1)/(IDIM+1)+1
  476. SEGADJ MCOORD
  477. XCOOR((NBPTS-1)*(IDIM+1)+1)=XPOIN
  478. XCOOR((NBPTS-1)*(IDIM+1)+2)=YPOIN
  479. IF (IDIM.EQ.3) XCOOR((NBPTS-1)*(IDIM+1)+3)=ZPOIN
  480. XCOOR(NBPTS*(IDIM+1))=TPOIN
  481. CALL ECROBJ('POINT ',NBPTS)
  482. RETURN
  483. END
  484.  
  485.  
  486.  
  487.  

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