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

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