Télécharger partxr.eso

Retour à la liste

Numérotation des lignes :

  1. C PARTXR SOURCE CHAT 11/03/16 21:28:46 6902
  2.  
  3. SUBROUTINE PARTXR (IMODLC,IMAILR, IMODLR)
  4.  
  5. C-----------------------------------------------------------------------
  6. C SOUS-PROGRAMME REALISANT LE PARTITIONNEMENT/REDUCTION DU MCHAML
  7. C D'ENRICHISSEMENT CONTENU DANS LE MODELE ASSOCIE A DES ELEMENTS
  8. C DE TYPE XFEM/RUPTURE
  9. C-----------------------------------------------------------------------
  10. C IMODLC Si IMODLC non nul :
  11. C Modele elementaire de REFERENCE (complet) s'appyant sur
  12. C des elements de type XFEM (formulation MFR=63), contenant
  13. C en particulier le MCHAML d'ENRICHISSEMENT
  14. C Segment IMODEL : ACTIF en Entree/Sortie & non modifie
  15. C IMAILR Maillage sur lequel on souhaite reduire le MCHAML
  16. C d'ENRICHISSEMENT du sous-modele IMODLC
  17. C Si IMAILR=0 en entree, on recupere le maillage contenu
  18. C dans IMODLR (suppose alors non nul)
  19. C Segment MELEME : non modifie
  20. C IMODLR Modele elementaire REDUIT contenant le MCHAML d'ENRICHIS-
  21. C SEMENT reduit s'appuyant sur IMAILR
  22. C Segment IMODEL : ACTIF en Sortie
  23. C Si IMODLR=0 en Entree, segment cree par copie de IMODLC
  24. C s'appuyant sur IMAILR (suppose alors non nul)
  25. C Sinon on utilise le segment tel quel.
  26. C Le sous-programme met ensuite a jour le MCHAML ENRICHIS
  27. C reduit au maillage IMAILR ou IMODLR.IMAMOD !
  28. C-----------------------------------------------------------------------
  29.  
  30. IMPLICIT INTEGER (I-N)
  31. IMPLICIT REAL*8 (A-H,O-Z)
  32.  
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36.  
  37. -INC SMCHAML
  38. -INC SMELEME
  39. -INC SMMODEL
  40.  
  41. C-
  42. IF (IMODLC.GT.0) THEN
  43. IMODEL = IMODLC
  44. SEGACT,IMODEL
  45. IF (IMODLR.EQ.0) THEN
  46. IF (IMAILR.EQ.0) THEN
  47. WRITE(IOIMP,*) '##### SOUS-PROGRAMME PARTXR #####'
  48. CALL ERREUR(21)
  49. RETURN
  50. ENDIF
  51. SEGINI,IMODE1=IMODEL
  52. IMODE1.IMAMOD = IMAILR
  53. IMODE1.INFMOD(2) = 0
  54. IMODLR = IMODE1
  55. ELSE
  56. IMODE1 = IMODLR
  57. SEGACT,IMODE1*MOD
  58. IF (IMAILR.NE.0) IMODE1.IMAMOD = IMAILR
  59. ENDIF
  60. ELSE
  61. IF (IMODLR.EQ.0 .OR. IMAILR.EQ.0) THEN
  62. WRITE(IOIMP,*) '##### SOUS-PROGRAMME PARTXR #####'
  63. CALL ERREUR(21)
  64. RETURN
  65. ENDIF
  66. IMODE1 = IMODLR
  67. SEGINI,IMODEL = IMODE1
  68. SEGACT,IMODE1*MOD
  69. IMODE1.IMAMOD = IMAILR
  70. ENDIF
  71. IMAIL1 = IMODE1.IMAMOD
  72.  
  73. C- Petit test pour gagner du temps ?
  74. IF (IMAMOD .EQ. IMAIL1) GOTO 900
  75.  
  76. C- Recuperation du MCHAML d enrichissement dans IMODEL
  77. CALL ICHAXR(IMODEL, ICHAMX,MCHELM)
  78. IF (ICHAMX .EQ. 0) GOTO 900
  79.  
  80. C- Reduction du MCHAML d'enrichissement au maillage concerne
  81. CALL REDUIC(MCHELM,IMAIL1, ICHAMR)
  82. IF (IERR.NE.0) GOTO 900
  83. IMODE1.IVAMOD(ICHAMX) = ICHAMR
  84.  
  85. C- Reactivation du maillage support du modele complet suite a reduction
  86. IF (IMODLC.NE.0) THEN
  87. MELEME = IMAMOD
  88. SEGACT,MELEME
  89. ENDIF
  90. C- Reactivation du maillage support du modele reduit suite a reduction
  91. MELEME = IMAIL1
  92. SEGACT,MELEME
  93.  
  94. 900 CONTINUE
  95. C* SEGDES,IMODE1
  96. C* SEGDES,IMODEL
  97. IF (IMODLC.EQ.0) SEGSUP,IMODEL
  98.  
  99. RETURN
  100. END
  101.  
  102.  
  103.  
  104.  

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