Télécharger dedu2.eso

Retour à la liste

Numérotation des lignes :

  1. C DEDU2 SOURCE PV 13/04/12 21:15:30 7756
  2. C DEDU2
  3. C
  4. C VERIFIE QUE LES POINTS DE LA GEOMETRIE ELEMENTAIRE IPT7
  5. C SONT BIEN POINTES DANS ICP1
  6. C APPELE PAR PROPER, POUR EXECUTION OPTIONS 'TRANS' ET 'ROTA' DE DEDU
  7. C
  8. C VERIFIE POUR DEDU ROTA QUE LES POINTS IMAGES SUPPOSES CORRESPONDENT
  9. C EGALEMENT A LA ROTATION DES POINTS ANTECEDENTS POUR L ANGLE ET L AXE
  10. C SPECIFIES
  11. C 97/11 : KICH
  12. SUBROUTINE DEDU2(IPT7,ICP1,IRETOU,ITYP)
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8 (A-H,O-Z)
  15. -INC CCOPTIO
  16. -INC SMCOORD
  17. -INC SMELEME
  18. SEGMENT ICP1(XCOOR(/1)/(IDIM+1))
  19. COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
  20. # ZVEC,ANGLE,ICLE
  21.  
  22. IF (ITYP.EQ.5) SEGACT MCOORD
  23. IRETOU=0
  24. SEGINI,IPT3=IPT7
  25. IF (IPT3.LISOUS(/1).NE.0) THEN
  26. IRETOU = 10
  27. * on ne verifie que les geometries elementaires (dedu2)
  28. CALL ERREUR(879)
  29. GOTO 200
  30. ENDIF
  31. CALL CHANGE(IPT3,1)
  32. SEGACT ICP1
  33. N = IPT3.NUM(/2)
  34. DO IJN=1,N
  35. * write(6,*)'noeud',IPT3.NUM(1,IJN),'pointe',ICP1(IPT3.NUM(1,IJN))
  36. IF (ICP1(IPT3.NUM(1,IJN)).EQ.0) THEN
  37. IRETOU=20
  38. GOTO 100
  39. ENDIF
  40. c verification pour ROTA
  41. IF (ITYP.EQ.5) THEN
  42. c image par la rotation
  43. IREF=IPT3.NUM(1,IJN)*(IDIM+1)
  44. IREF=IREF-IDIM
  45. XD=XCOOR(IREF)-XPT1
  46. YD=XCOOR(IREF+1)-YPT1
  47. ZD=XCOOR(IREF+2)-ZPT1
  48. IF (IDIM.EQ.2) ZD=0.
  49. XDENS=XCOOR(IREF+IDIM)
  50. CO=COS(ANGLE)
  51. SI=SIN(ANGLE)
  52. XE=XD*XV1+YD*YV1+ZD*ZV1
  53. YE=XD*XV2+YD*YV2+ZD*ZV2
  54. ZE=XD*XVEC+YD*YVEC+ZD*ZVEC
  55. XD=XE*CO-YE*SI
  56. YD=XE*SI+YE*CO
  57. ZD=ZE
  58. XIMA=XD*XV1+YD*XV2+ZD*XVEC+XPT1
  59. YIMA=XD*YV1+YD*YV2+ZD*YVEC+YPT1
  60. IF (IDIM.NE.2) ZIMA=XD*ZV1+YD*ZV2+ZD*ZVEC+ZPT1
  61. c image pointee
  62. IREF=ICP1(IPT3.NUM(1,IJN))*(IDIM+1)
  63. IREF=IREF-IDIM
  64. XPOIN=XCOOR(IREF)
  65. YPOIN=XCOOR(IREF+1)
  66. ZPOIN=XCOOR(IREF+2)
  67. DELTX = ABS(XIMA - XPOIN)
  68. DELTY = ABS(YIMA - YPOIN)
  69. IF (IDIM.EQ.3) DELTZ = ABS(ZIMA - ZPOIN)
  70. IF (IDIM.LT.3) THEN
  71. IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))
  72. 2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))) THEN
  73. CONTINUE
  74. ELSE
  75. CALL ERREUR(885)
  76. RETURN
  77. ENDIF
  78. ELSE IF (IDIM.EQ.3) THEN
  79. IF ((DELTX.LE.(1.E-4*ABS(XPOIN)))
  80. 2.AND.(DELTY.LE.(1.E-4*ABS(YPOIN)))
  81. 3.AND.(DELTZ.LE.(1.E-4*ABS(ZPOIN)))) THEN
  82. CONTINUE
  83. ELSE
  84. CALL ERREUR(885)
  85. RETURN
  86. ENDIF
  87. ENDIF
  88. ENDIF
  89. ENDDO
  90. 100 CONTINUE
  91. SEGDES ICP1
  92.  
  93. 200 CONTINUE
  94. RETURN
  95. END
  96.  
  97.  
  98.  
  99.  
  100.  

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