Télécharger piocau.eso

Retour à la liste

Numérotation des lignes :

  1. C PIOCAU SOURCE CB215821 16/12/05 21:40:19 9237
  2. SUBROUTINE PIOCAU(IM)
  3. C=======================================================================
  4. C OPERATEUR TRANSFORMANT LES CONTRAINTES DE PIOLA KIRCHHOFF
  5. C EN CONTRAINTES DE CAUCHY ET RECIPROQUEMENT
  6. C
  7. C IM = 0 : SI2 = PICA MODL1 SI1 DU (UXFEM) ;
  8. C IM = 1 : SI2 = CAPI MODL1 SI1 DU (UXFEM) ;
  9. C
  10. C MODL1= OBJET MODELE (TYPE MMODEL)
  11. C
  12. C SI1 = CHAMP DE CONTRAINTES (TYPE MCHAML)EN ENTREE
  13. C OU DE DEFORMATIONS
  14. C
  15. C SI2 = CHAMP DE CONTRAINTES (TYPE MCHAML) EN SORTIE
  16. C OU DE DEFORMATIONS
  17. C
  18. C DU = INCRMT DE DEPLACEMENT ENTRE CONFIG DE DEPART ET ACTUELLE
  19. C (TYPE CHPOINT)
  20. C
  21. C UXFEM = DEPLACEMENT ENRICHI ENTRE CONFIG FISSURE FERMEE ET
  22. C CONFIG DE DEPART (elements xq4r et xc8r)
  23. C
  24. C CODE COMBESCURE SEPT 87
  25. C
  26. C PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI le 12/4/91
  27. C=======================================================================
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30.  
  31. -INC CCOPTIO
  32. -INC SMMODEL
  33. -INC SMCHAML
  34. POINTEUR MCHEX1.MCHELM
  35. C
  36. IPMODL=0
  37. IPCHE1=0
  38. IPCHE2=0
  39. IPCHP1=0
  40. *as xfem 2010_01_13
  41. IPCHP0=0
  42. ICHAX1=0
  43.  
  44. CALL LIROBJ('MMODEL',IPMODL,1,IRT1)
  45. IF(IERR.NE.0)RETURN
  46. C
  47. C ON LIT LE MCHAML A TRANSFORMER
  48. C
  49. CALL LIROBJ('MCHAML',IPIN,1,IRT1)
  50. IF(IERR.NE.0) RETURN
  51. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  52. IF(IR .NE. 1) CALL ERREUR(KER)
  53. IF(IERR .NE. 0) RETURN
  54. C
  55. C ON LIT UN CHPOINT DE DEPLACEMENTS
  56. C
  57. CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT1)
  58. IF(IERR.NE.0) RETURN
  59. C
  60. CALL LIROBJ('CHPOINT',IPCHP0,0,IRT1)
  61. IF (IERR.NE.0) RETURN
  62.  
  63. *as xfem 2010_01_13
  64. if (ierr.ne.0) then
  65. if (ichax1.ne.0) then
  66. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  67. & 'deplacement entre la config. 0 et la config. de reference'
  68. return
  69. endif
  70. endif
  71. C
  72. MMODEL = IPMODL
  73. SEGACT MMODEL
  74. NBPART = KMODEL(/1)
  75. IPICA = 0
  76. DO 4 IPART=1,NBPART
  77. IMODEL = KMODEL(IPART)
  78. SEGACT IMODEL
  79. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  80. C doivent pas modifier les champs !
  81. IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  82. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  83. C et ne doivent donc pas etre transportees !
  84. IF ( INATUU.EQ.-1) IPICA = IPICA+1
  85. C Verification presence XFEM
  86. *as xfem 2010_01_13
  87. NOBMO1=IVAMOD(/1)
  88. if (NOBMO1.ne.0) then
  89. Do iobmo1=1,NOBMO1
  90. if (TYMODE(iobmo1).eq.'MCHAML') then
  91. MCHEX1=IVAMOD(iobmo1)
  92. SEGACT MCHEX1
  93. if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  94. ICHAX1 = MCHEX1.ICHAML(1)
  95. SEGDES MCHEX1
  96. goto 3
  97. endif
  98. SEGDES MCHEX1
  99. endif
  100. Enddo
  101. endif
  102. 3 CONTINUE
  103. *fin as xfem 2010_01_13
  104. SEGDES IMODEL
  105. 4 CONTINUE
  106. SEGDES MMODEL
  107.  
  108. C Presence XFEM -> pointeur ICHAX1 non nul
  109. *as xfem 2010_01_13
  110. if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  111. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  112. & 'deplacement entre la config. 0 et la config. de reference'
  113. CALL ERREUR(21)
  114. return
  115. endif
  116.  
  117. C IPICA = NBPART -> Le modele entier est de type UO2 et/ou OTTOSEN
  118. C et/ou contient des modeles UMAT
  119. C Recopie MCHAML IPCHE1 tel quel et on quitte
  120. IF (IPICA.EQ.NBPART) THEN
  121. IRET = 1
  122. CALL COPIE8(IPCHE1,IPCHE2)
  123. C
  124. C Melange de MODELEs : Traitement GENERAL
  125. C
  126. ELSE
  127. IRET = 0
  128. CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IPCHE2,IRET)
  129. ENDIF
  130.  
  131. IF (IRET.EQ.1) CALL ECROBJ('MCHAML',IPCHE2)
  132.  
  133. RETURN
  134. END
  135.  
  136.  
  137.  
  138.  

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