Télécharger piocau.eso

Retour à la liste

Numérotation des lignes :

piocau
  1. C PIOCAU SOURCE PV090527 24/04/30 21:15:01 11926
  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) (MODERIV);
  8. C IM = 1 : SI2 = CAPI MODL1 SI1 DU (UXFEM) (MODERIV);
  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 MODERIV = mot cle optionnel parmi 'JAUM' ou 'UTIL'
  25. C
  26. C CODE COMBESCURE SEPT 87
  27. C
  28. C=======================================================================
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMMODEL
  36. -INC SMCHAML
  37. POINTEUR MCHEX1.MCHELM
  38. C
  39. PARAMETER(NDERI=7)
  40. CHARACTER*4 MODERI(NDERI)
  41. DATA MODERI/'LINE','QUAD','I ','II ','TRUE','JAUM','UTIL'/
  42. c -> IDERI = 1 2 1 2 3 4 5
  43. c traitement particulier uniquement si IDERI = 4 ou 5
  44.  
  45. C-----------------------------------------------------------------------
  46.  
  47. IPMODL=0
  48. IPCHE1=0
  49. IPCHE2=0
  50. IPCHP1=0
  51. *as xfem 2010_01_13
  52. IPCHP0=0
  53. ICHAX1=0
  54. IDERI=0
  55.  
  56. c option de calcul des deformations (par defaut lineaires)
  57. CALL LIRMOT(MODERI,NDERI,IDERI,0)
  58. IF(IDERI.EQ.0) IDERI=1
  59. IF(IDERI.GE.3) IDERI=IDERI-2
  60.  
  61. CALL LIROBJ('MMODEL ',IPMODL,1,IRT1)
  62. IF(IERR.NE.0) RETURN
  63. CALL ACTOBJ('MMODEL ',IPMODL,1)
  64. IF(IERR.NE.0)RETURN
  65. C
  66. C ON LIT LE MCHAML A TRANSFORMER
  67. C
  68. CALL LIROBJ('MCHAML ',IPIN,1,IRT1)
  69. if (ipin.eq.0) ierr=2
  70. IF(IERR.NE.0) RETURN
  71. CALL ACTOBJ('MCHAML ',IPIN,1)
  72. IF(IERR.NE.0) RETURN
  73. mchelm=ipin
  74. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  75. mchelm=ipche1
  76. IF(IR .NE. 1) CALL ERREUR(KER)
  77. IF(IERR .NE. 0) RETURN
  78. C
  79. C ON LIT UN CHPOINT DE DEPLACEMENTS
  80. C
  81. CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT1)
  82. IF(IERR.NE.0) RETURN
  83. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  84. IF(IERR.NE.0) RETURN
  85. C
  86. CALL LIROBJ('CHPOINT ',IPCHP0,0,IRT1)
  87. IF (IRT1 .EQ. 1) CALL ACTOBJ('CHPOINT ',IPCHP0,1)
  88. IF (IERR.NE.0) RETURN
  89.  
  90. *as xfem 2010_01_13
  91. if (ierr.ne.0) then
  92. if (ichax1.ne.0) then
  93. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  94. & 'deplacement entre la config. 0 et la config. de reference'
  95. return
  96. endif
  97. endif
  98. C
  99. MMODEL = IPMODL
  100. NBPART = KMODEL(/1)
  101. IPICA = 0
  102. DO 4 IPART=1,NBPART
  103. IMODEL = KMODEL(IPART)
  104. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  105. C doivent pas modifier les champs !
  106. * septembre 2019: cette restriction est enlevee
  107. ** IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  108. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  109. C et ne doivent donc pas etre transportees !
  110. IF ( INATUU.EQ.-1) IPICA = IPICA+1
  111. C Verification presence XFEM
  112. *as xfem 2010_01_13
  113. NOBMO1=IVAMOD(/1)
  114. if (NOBMO1.ne.0) then
  115. Do iobmo1=1,NOBMO1
  116. if (TYMODE(iobmo1).eq.'MCHAML') then
  117. MCHEX1=IVAMOD(iobmo1)
  118. if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  119. ICHAX1 = MCHEX1.ICHAML(1)
  120. goto 3
  121. endif
  122. endif
  123. Enddo
  124. endif
  125. 3 CONTINUE
  126. *fin as xfem 2010_01_13
  127. 4 CONTINUE
  128.  
  129. C Presence XFEM -> pointeur ICHAX1 non nul
  130. *as xfem 2010_01_13
  131. if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  132. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  133. & 'deplacement entre la config. 0 et la config. de reference'
  134. CALL ERREUR(21)
  135. return
  136. endif
  137.  
  138. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  139. C Recopie MCHAML IPCHE1 tel quel et on quitte
  140. IF (IPICA.EQ.NBPART) THEN
  141. IRET = 1
  142. CALL COPIE8(IPCHE1,IPCHE2)
  143. C
  144. C Melange de MODELEs : Traitement GENERAL
  145. C
  146. ELSE
  147. IRET = 0
  148. CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IDERI,
  149. & IPCHE2,IRET)
  150. ENDIF
  151.  
  152. IF (IRET.EQ.1) THEN
  153. CALL ACTOBJ('MCHAML ',IPCHE2,1)
  154. CALL ECROBJ('MCHAML ',IPCHE2)
  155. ENDIF
  156.  
  157. END
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  

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