Télécharger prliai.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIAI SOURCE BP208322 16/11/18 21:20:11 9177
  2. C
  3. C CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTS
  4. C LIAISON NORMAUX OU LES ELEMENTS LIAISON POREUX (BALD)
  5. C
  6. SUBROUTINE PRLIAI
  7. IMPLICIT INTEGER(I-N)
  8. implicit real*8 (a-h,o-z)
  9. -INC CCOPTIO
  10. -INC SMELEME
  11. -INC CCGEOME
  12. SEGMENT LISOBJ(0)
  13. REAL*8 XXX
  14. IPT3=0
  15. XXX=DENSIT/10.
  16. CALL LIRREE(XXX,0,IRETOU)
  17. CRIT=ABS(REAL(XXX))
  18. 20 CONTINUE
  19. IF (CRIT.EQ.0.) CALL ERREUR(21)
  20. IF (IERR.NE.0) RETURN
  21. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
  22. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
  23. CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU)
  24. IF (IERR.NE.0) RETURN
  25. SEGACT IPT1
  26. SEGACT IPT2
  27. IF (IPT3.NE.0) SEGACT IPT3
  28. SEGINI LISOBJ
  29. C
  30. C ON RECHERCHE LES PARTIES DE MEME TYPE
  31. C
  32. IPT4=IPT1
  33. DO 1001 IOBI=1,MAX(1,IPT1.LISOUS(/1))
  34. IF (IPT1.LISOUS(/1).NE.0) THEN
  35. IPT4=IPT1.LISOUS(IOBI)
  36. SEGACT IPT4
  37. ENDIF
  38. IF (KSURF(IPT4.ITYPEL).NE.IPT4.ITYPEL) GOTO 1002
  39. IPT5=IPT2
  40. DO 1006 IOBJ=1,MAX(1,IPT2.LISOUS(/1))
  41. IF (IPT2.LISOUS(/1).NE.0) THEN
  42. IPT5=IPT2.LISOUS(IOBJ)
  43. SEGACT IPT5
  44. ENDIF
  45. IF (KSURF(IPT5.ITYPEL).NE.IPT5.ITYPEL) GOTO 1007
  46. IF (IPT4.ITYPEL.NE.IPT5.ITYPEL) GOTO 1007
  47. IF (IPT3.NE.0) THEN
  48. C
  49. C CAS DES ELELMENTS JOINTS POREUX
  50. C
  51. IPT6=IPT3
  52. DO 1008 IOBK=1,MAX(1,IPT3.LISOUS(/1))
  53. IF (IPT3.LISOUS(/1).NE.0) THEN
  54. IPT6=IPT3.LISOUS(IOBK)
  55. SEGACT IPT6
  56. ENDIF
  57. IF (KSURF(IPT6.ITYPEL).NE.IPT6.ITYPEL) GOTO 1009
  58. IF (IPT4.ITYPEL.EQ.IPT6.ITYPEL) GOTO 1009
  59. IF (NBSOM(IPT4.ITYPEL).NE.NBSOM(IPT6.ITYPEL)) GOTO 1009
  60. IPT7=0
  61. CALL LIAPOR(IPT4,IPT5,IPT6,IPT7,CRIT)
  62. IF (IERR.NE.0) GOTO 1003
  63. IF (IPT7.NE.0) LISOBJ(**)=IPT7
  64. 1009 CONTINUE
  65. IF (IPT3.LISOUS(/1).NE.0) SEGDES IPT6
  66. 1008 CONTINUE
  67. ELSE
  68. C
  69. C CAS DES ELELMENTS JOINTS NORMAUX
  70. C
  71. IPT7=0
  72. CALL LIAISO(IPT4,IPT5,IPT7,CRIT)
  73. IF (IERR.NE.0) GOTO 1003
  74. IF (IPT7.NE.0) LISOBJ(**)=IPT7
  75. END IF
  76. 1007 CONTINUE
  77. IF (IPT2.LISOUS(/1).NE.0) SEGDES IPT5
  78. 1006 CONTINUE
  79. 1002 CONTINUE
  80. IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT4
  81. 1001 CONTINUE
  82. 1003 CONTINUE
  83. SEGDES IPT1,IPT2
  84. IF (IPT3.NE.0) SEGDES IPT3
  85. IF (LISOBJ(/1).NE.0.AND.IERR.EQ.0) GOTO 2000
  86. CALL ERREUR(26)
  87. SEGSUP LISOBJ
  88. RETURN
  89. 2000 IF (LISOBJ(/1).GT.1) GOTO 2001
  90. IPT4=LISOBJ(1)
  91. SEGDES IPT4
  92. GOTO 2002
  93. 2001 NBNN=0
  94. NBELEM=0
  95. NBREF=0
  96. NBSOUS=LISOBJ(/1)
  97. SEGINI IPT4
  98. DO 2010 IOB=1,LISOBJ(/1)
  99. IPT7=LISOBJ(IOB)
  100. SEGDES IPT7
  101. IPT4.LISOUS(IOB)=IPT7
  102. 2010 CONTINUE
  103. 2002 SEGSUP LISOBJ
  104. CALL ECROBJ('MAILLAGE',IPT4)
  105. RETURN
  106. END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  

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