Télécharger piocau.eso

Retour à la liste

Numérotation des lignes :

  1. C PIOCAU SOURCE PV 19/09/10 21:15:07 10295
  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.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMMODEL
  35. -INC SMCHAML
  36. POINTEUR MCHEX1.MCHELM
  37. C
  38. IPMODL=0
  39. IPCHE1=0
  40. IPCHE2=0
  41. IPCHP1=0
  42. *as xfem 2010_01_13
  43. IPCHP0=0
  44. ICHAX1=0
  45.  
  46. CALL LIROBJ('MMODEL ',IPMODL,1,IRT1)
  47. CALL ACTOBJ('MMODEL ',IPMODL,1)
  48. IF(IERR.NE.0)RETURN
  49. C
  50. C ON LIT LE MCHAML A TRANSFORMER
  51. C
  52. CALL LIROBJ('MCHAML ',IPIN,1,IRT1)
  53. CALL ACTOBJ('MCHAML ',IPIN,1)
  54. IF(IERR.NE.0) RETURN
  55. mchelm=ipin
  56. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  57. mchelm=ipche1
  58. IF(IR .NE. 1) CALL ERREUR(KER)
  59. IF(IERR .NE. 0) RETURN
  60. C
  61. C ON LIT UN CHPOINT DE DEPLACEMENTS
  62. C
  63. CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT1)
  64. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  65. IF(IERR.NE.0) RETURN
  66. C
  67. CALL LIROBJ('CHPOINT ',IPCHP0,0,IRT1)
  68. IF (IRT1 .EQ. 1) CALL ACTOBJ('CHPOINT ',IPCHP0,1)
  69. IF (IERR.NE.0) RETURN
  70.  
  71. *as xfem 2010_01_13
  72. if (ierr.ne.0) then
  73. if (ichax1.ne.0) then
  74. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  75. & 'deplacement entre la config. 0 et la config. de reference'
  76. return
  77. endif
  78. endif
  79. C
  80. MMODEL = IPMODL
  81. NBPART = KMODEL(/1)
  82. IPICA = 0
  83. DO 4 IPART=1,NBPART
  84. IMODEL = KMODEL(IPART)
  85. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  86. C doivent pas modifier les champs !
  87. * septembre 2019: cette restriction est enlevee
  88. ** IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  89. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  90. C et ne doivent donc pas etre transportees !
  91. IF ( INATUU.EQ.-1) IPICA = IPICA+1
  92. C Verification presence XFEM
  93. *as xfem 2010_01_13
  94. NOBMO1=IVAMOD(/1)
  95. if (NOBMO1.ne.0) then
  96. Do iobmo1=1,NOBMO1
  97. if (TYMODE(iobmo1).eq.'MCHAML') then
  98. MCHEX1=IVAMOD(iobmo1)
  99. if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  100. ICHAX1 = MCHEX1.ICHAML(1)
  101. goto 3
  102. endif
  103. endif
  104. Enddo
  105. endif
  106. 3 CONTINUE
  107. *fin as xfem 2010_01_13
  108. 4 CONTINUE
  109.  
  110. C Presence XFEM -> pointeur ICHAX1 non nul
  111. *as xfem 2010_01_13
  112. if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  113. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  114. & 'deplacement entre la config. 0 et la config. de reference'
  115. CALL ERREUR(21)
  116. return
  117. endif
  118.  
  119. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  120. C Recopie MCHAML IPCHE1 tel quel et on quitte
  121. IF (IPICA.EQ.NBPART) THEN
  122. IRET = 1
  123. CALL COPIE8(IPCHE1,IPCHE2)
  124. C
  125. C Melange de MODELEs : Traitement GENERAL
  126. C
  127. ELSE
  128. IRET = 0
  129. CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IPCHE2,IRET)
  130. ENDIF
  131.  
  132. IF (IRET.EQ.1) THEN
  133. CALL ACTOBJ('MCHAML ',IPCHE2,1)
  134. CALL ECROBJ('MCHAML ',IPCHE2)
  135. ENDIF
  136.  
  137. END
  138.  
  139.  
  140.  
  141.  

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