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. -INC CCOPTIO
  34.  
  35. -INC SMCHAML
  36. -INC SMELEME
  37. -INC SMMODEL
  38.  
  39. C-
  40. IF (IMODLC.GT.0) THEN
  41. IMODEL = IMODLC
  42. SEGACT,IMODEL
  43. IF (IMODLR.EQ.0) THEN
  44. IF (IMAILR.EQ.0) THEN
  45. WRITE(IOIMP,*) '##### SOUS-PROGRAMME PARTXR #####'
  46. CALL ERREUR(21)
  47. RETURN
  48. ENDIF
  49. SEGINI,IMODE1=IMODEL
  50. IMODE1.IMAMOD = IMAILR
  51. IMODE1.INFMOD(2) = 0
  52. IMODLR = IMODE1
  53. ELSE
  54. IMODE1 = IMODLR
  55. SEGACT,IMODE1*MOD
  56. IF (IMAILR.NE.0) IMODE1.IMAMOD = IMAILR
  57. ENDIF
  58. ELSE
  59. IF (IMODLR.EQ.0 .OR. IMAILR.EQ.0) THEN
  60. WRITE(IOIMP,*) '##### SOUS-PROGRAMME PARTXR #####'
  61. CALL ERREUR(21)
  62. RETURN
  63. ENDIF
  64. IMODE1 = IMODLR
  65. SEGINI,IMODEL = IMODE1
  66. SEGACT,IMODE1*MOD
  67. IMODE1.IMAMOD = IMAILR
  68. ENDIF
  69. IMAIL1 = IMODE1.IMAMOD
  70.  
  71. C- Petit test pour gagner du temps ?
  72. IF (IMAMOD .EQ. IMAIL1) GOTO 900
  73.  
  74. C- Recuperation du MCHAML d enrichissement dans IMODEL
  75. CALL ICHAXR(IMODEL, ICHAMX,MCHELM)
  76. IF (ICHAMX .EQ. 0) GOTO 900
  77.  
  78. C- Reduction du MCHAML d'enrichissement au maillage concerne
  79. CALL REDUIC(MCHELM,IMAIL1, ICHAMR)
  80. IF (IERR.NE.0) GOTO 900
  81. IMODE1.IVAMOD(ICHAMX) = ICHAMR
  82.  
  83. C- Reactivation du maillage support du modele complet suite a reduction
  84. IF (IMODLC.NE.0) THEN
  85. MELEME = IMAMOD
  86. SEGACT,MELEME
  87. ENDIF
  88. C- Reactivation du maillage support du modele reduit suite a reduction
  89. MELEME = IMAIL1
  90. SEGACT,MELEME
  91.  
  92. 900 CONTINUE
  93. C* SEGDES,IMODE1
  94. C* SEGDES,IMODEL
  95. IF (IMODLC.EQ.0) SEGSUP,IMODEL
  96.  
  97. RETURN
  98. END
  99.  
  100.  
  101.  
  102.  

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