Télécharger prracc.eso

Retour à la liste

Numérotation des lignes :

  1. C PRRACC SOURCE BP208322 16/11/18 21:20:21 9177
  2. C
  3. C CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTS
  4. C RACCORD NORMAUX OU LES ELEMENTS RACCORD POREUX (BALD)
  5. C
  6. SUBROUTINE PRRACC
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. -INC CCOPTIO
  11. -INC CCGEOME
  12. -INC SMELEME
  13.  
  14. XXX=DENSIT/10.
  15. CALL LIRREE(XXX,0,IRETOU)
  16. IF (IERR.NE.0) RETURN
  17. CRIT=ABS(XXX)
  18. IF (CRIT.EQ.0.) THEN
  19. CALL ERREUR(21)
  20. RETURN
  21. ENDIF
  22.  
  23. IPT3=0
  24. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  25. IF (IERR.NE.0) RETURN
  26. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  27. IF (IERR.NE.0) RETURN
  28. CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU)
  29. IF (IERR.NE.0) RETURN
  30. C
  31. SEGACT IPT1
  32. IF (IPT1.LISOUS(/1).NE.0) GOTO 102
  33. IF (KSURF(IPT1.ITYPEL).EQ.0) GOTO 101
  34. 102 CONTINUE
  35. CALL ECROBJ('MAILLAGE',IPT1)
  36. CALL PRCONT
  37. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  38. IF (IERR.NE.0) RETURN
  39. SEGACT IPT1
  40. 101 CONTINUE
  41. C
  42. SEGACT IPT2
  43. IF (IPT2.LISOUS(/1).NE.0) GOTO 202
  44. IF (KSURF(IPT2.ITYPEL).EQ.0) GOTO 201
  45. 202 CONTINUE
  46. CALL ECROBJ('MAILLAGE',IPT2)
  47. CALL PRCONT
  48. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  49. IF (IERR.NE.0) RETURN
  50. SEGACT IPT2
  51. 201 CONTINUE
  52. C
  53. IF(IPT3.NE.0)THEN
  54. C
  55. C CAS DES ELELMENTS JOINTS POREUX
  56. C
  57. SEGACT IPT3
  58. IF (IPT3.LISOUS(/1).NE.0) GOTO 302
  59. IF (KSURF(IPT3.ITYPEL).EQ.0) GOTO 301
  60. 302 CONTINUE
  61. SEGDES IPT1,IPT2,IPT3
  62. CALL ERREUR(26)
  63. RETURN
  64. 301 CONTINUE
  65. CALL RACPOR(IPT1,IPT2,IPT3,IPT4,CRIT)
  66. SEGDES IPT1,IPT2,IPT3
  67. C
  68. ELSE
  69. C
  70. C CAS DES ELELMENTS JOINTS NORMAUX
  71. C
  72. CALL RACCOR(IPT1,IPT2,IPT4,CRIT)
  73. SEGDES IPT1,IPT2
  74. C
  75. END IF
  76. C
  77. IF (IERR.NE.0) RETURN
  78. SEGDES IPT4
  79. CALL ECROBJ('MAILLAGE',IPT4)
  80.  
  81. RETURN
  82. END
  83.  
  84.  
  85.  
  86.  
  87.  

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