Télécharger piocau.eso

Retour à la liste

Numérotation des lignes :

piocau
  1. C PIOCAU SOURCE FD218221 20/12/17 21:15:47 10820
  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. CALL ACTOBJ('MMODEL ',IPMODL,1)
  63. IF(IERR.NE.0)RETURN
  64. C
  65. C ON LIT LE MCHAML A TRANSFORMER
  66. C
  67. CALL LIROBJ('MCHAML ',IPIN,1,IRT1)
  68. CALL ACTOBJ('MCHAML ',IPIN,1)
  69. IF(IERR.NE.0) RETURN
  70. mchelm=ipin
  71. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  72. mchelm=ipche1
  73. IF(IR .NE. 1) CALL ERREUR(KER)
  74. IF(IERR .NE. 0) RETURN
  75. C
  76. C ON LIT UN CHPOINT DE DEPLACEMENTS
  77. C
  78. CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT1)
  79. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  80. IF(IERR.NE.0) RETURN
  81. C
  82. CALL LIROBJ('CHPOINT ',IPCHP0,0,IRT1)
  83. IF (IRT1 .EQ. 1) CALL ACTOBJ('CHPOINT ',IPCHP0,1)
  84. IF (IERR.NE.0) RETURN
  85.  
  86. *as xfem 2010_01_13
  87. if (ierr.ne.0) then
  88. if (ichax1.ne.0) then
  89. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  90. & 'deplacement entre la config. 0 et la config. de reference'
  91. return
  92. endif
  93. endif
  94. C
  95. MMODEL = IPMODL
  96. NBPART = KMODEL(/1)
  97. IPICA = 0
  98. DO 4 IPART=1,NBPART
  99. IMODEL = KMODEL(IPART)
  100. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  101. C doivent pas modifier les champs !
  102. * septembre 2019: cette restriction est enlevee
  103. ** IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  104. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  105. C et ne doivent donc pas etre transportees !
  106. IF ( INATUU.EQ.-1) IPICA = IPICA+1
  107. C Verification presence XFEM
  108. *as xfem 2010_01_13
  109. NOBMO1=IVAMOD(/1)
  110. if (NOBMO1.ne.0) then
  111. Do iobmo1=1,NOBMO1
  112. if (TYMODE(iobmo1).eq.'MCHAML') then
  113. MCHEX1=IVAMOD(iobmo1)
  114. if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  115. ICHAX1 = MCHEX1.ICHAML(1)
  116. goto 3
  117. endif
  118. endif
  119. Enddo
  120. endif
  121. 3 CONTINUE
  122. *fin as xfem 2010_01_13
  123. 4 CONTINUE
  124.  
  125. C Presence XFEM -> pointeur ICHAX1 non nul
  126. *as xfem 2010_01_13
  127. if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  128. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  129. & 'deplacement entre la config. 0 et la config. de reference'
  130. CALL ERREUR(21)
  131. return
  132. endif
  133.  
  134. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  135. C Recopie MCHAML IPCHE1 tel quel et on quitte
  136. IF (IPICA.EQ.NBPART) THEN
  137. IRET = 1
  138. CALL COPIE8(IPCHE1,IPCHE2)
  139. C
  140. C Melange de MODELEs : Traitement GENERAL
  141. C
  142. ELSE
  143. IRET = 0
  144. CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IDERI,
  145. & IPCHE2,IRET)
  146. ENDIF
  147.  
  148. IF (IRET.EQ.1) THEN
  149. CALL ACTOBJ('MCHAML ',IPCHE2,1)
  150. CALL ECROBJ('MCHAML ',IPCHE2)
  151. ENDIF
  152.  
  153. END
  154.  
  155.  
  156.  
  157.  
  158.  

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