Télécharger config.eso

Retour à la liste

Numérotation des lignes :

config
  1. C CONFIG SOURCE PV090527 25/01/13 21:15:01 12111
  2. SUBROUTINE CONFIG
  3. C=======================================================================
  4. C OPERATEUR TRANSFORMANT LES CONTRAINTES SUR LA CONFIGURATION COURANTE
  5. C
  6. C MOD1= OBJET MODELE (TYPE MMODEL)
  7. C
  8. C SI1 = CHAMP DE CONTRAINTES (TYPE MCHAML)EN ENTREE
  9. C OU DE DEFORMATIONS
  10. C
  11. C SI2 = CHAMP DE CONTRAINTES (TYPE MCHAML) EN SORTIE
  12. C OU DE DEFORMATIONS
  13. C
  14. C CNF = CONFIGURATION COURANTE
  15. C
  16. C CODE COMBESCURE SEPT 87
  17. C
  18. C=======================================================================
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21.  
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMMODEL
  26. -INC SMCHAML
  27. -INC SMCOORD
  28. -INC SMCHPOI
  29. -INC SMELEME
  30. POINTEUR MCHEX1.MCHELM
  31. C
  32. PARAMETER(NDERI=7)
  33. CHARACTER*4 MODERI(NDERI)
  34. DATA MODERI/'LINE','QUAD','I ','II ','TRUE','JAUM','UTIL'/
  35. c -> IDERI = 1 2 1 2 3 4 5
  36. c traitement particulier uniquement si IDERI = 4 ou 5
  37.  
  38. CHARACTER*(LOCOMP) NODEF(3),NODEG(3)
  39. CHARACTER*(LOCOMP) RODEF(3),RODEG(3)
  40.  
  41. DATA NODEF / 'UX ','UY ','UZ ' /
  42. DATA NODEG / 'UR ','UZ ','UT ' /
  43. DATA RODEF / 'RX ','RY ','RZ ' /
  44. DATA RODEG / 'RR ','RZ ','RT ' /
  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. im=1
  56. ideri=1
  57.  
  58. CALL LIROBJ('MMODEL ',IPMODL,1,IRT1)
  59. IF(IERR.NE.0) RETURN
  60. CALL ACTOBJ('MMODEL ',IPMODL,2)
  61. IF(IERR.NE.0)RETURN
  62. C
  63. C ON LIT LE MCHAML A TRANSFORMER
  64. C
  65. CALL LIROBJ('MCHAML ',IPIN,1,IRT1)
  66. if (ipin.eq.0) ierr=2
  67. IF(IERR.NE.0) RETURN
  68. call verrou(2)
  69. segact mcoord*mod
  70. mchelm=ipin
  71. * sauver les configuration et passage dans mclcnf pour le reduaf
  72. segact mchelm
  73. if(mclcnf.eq.0) then
  74. call ecrobj('MCHAML ',ipin)
  75. call verrou(3)
  76. return
  77. endif
  78. ** mclcns=mclcnf
  79. mcoors=mcoord
  80. ** mcoord=mclcns
  81. CALL ACTOBJ('MCHAML ',IPIN,2)
  82. IF(IERR.NE.0) RETURN
  83. segact mcoord
  84. nbpts=xcoor(/1)/(idim+1)
  85. ** write (6,*) 'mclcnf mcoord avant reduag',mclcnf,mcoord
  86. * ici faire quelque chose pour que reduaf ne plante pas sur une erreur de configuration
  87. CALL REDUAG(IPIN,IPMODL,IPCHE1,0,IR,KER)
  88. if (ierr.ne.0) return
  89. mchelm=ipche1
  90. ** A cause du cache la configuration peut etre mauvaise
  91. segact mchelm*mod
  92. ** mclcnf=mclcns
  93. ** segact mchelm
  94. ** write (6,*) 'mcoors mcoord apres reduag',mcoors,mcoord
  95. IF(IR .NE. 1) CALL ERREUR(KER)
  96. IF(IERR .NE. 0) RETURN
  97. C
  98. C ON construit le chpoint de deplacement a partir de la config courante et de celle du
  99. C chamelem
  100. C
  101. icar=0
  102. if (titche.eq.'CARACTERISTIQUES') icar = 1
  103.  
  104. call lirobj('CHPOINT ',ipchp1,0,iretou)
  105. mchpoi=ipchp1
  106. if (iretou.eq.0) then
  107. mcoor1 = mcoors
  108. segact,mcoord,mcoor1
  109. nbpts1=mcoor1.xcoor(/1)/(idim+1)
  110. NAT=2
  111. NSOUPO=1
  112. SEGINI MCHPOI
  113. ipchp1=mchpoi
  114. NCB=2
  115. if (ifour.eq.2) ncB=3
  116. segact MCOORD
  117. nc=ncb
  118. mrotat=mrota
  119. mrota1=mcoor1.mrota
  120. if (mrotat.ne.0) then
  121. nc=2*ncB
  122. segact mrotat,mrota1
  123. endif
  124. SEGINI MSOUPO
  125. IPCHP(1)=msoupo
  126. if (ifour.ne.0.and.ifour.ne.1) then
  127. do i=1,ncb
  128. nocomp(i)=nodef(i)
  129. enddo
  130. else
  131. do i=1,ncb
  132. nocomp(i)=nodeg(i)
  133. enddo
  134. endif
  135. if (mrotat.ne.0) then
  136. if (ifour.ne.0.and.ifour.ne.1) then
  137. do i=1,ncb
  138. nocomp(i+ncb)=rodef(i)
  139. enddo
  140. else
  141. do i=1,ncb
  142. nocomp(i+ncb)=rodeg(i)
  143. enddo
  144. endif
  145. endif
  146. N=nbpts1
  147. segini mpoval
  148. ipoval=mpoval
  149. if (nbpts1.gt.nbpts) then
  150. nbpts=nbpts1
  151. segadj mcoord
  152. endif
  153. if(icar.eq.0) then
  154. do i=1,nbpts
  155. do j=1,idim
  156. ij=(i-1)*(idim+1)+j
  157. ij0=(i-1)*idim+j
  158. vpocha(i,j)=xcoor(ij)-mcoor1.xcoor(ij)
  159. if(mrota.ne.0) vpocha(i,j+ncb)=xrota(ij0)-mrota1.xrota(ij0)
  160. enddo
  161. enddo
  162. else
  163. do i=1,nbpts
  164. do j=1,idim
  165. ij=(i-1)*(idim+1)+j
  166. ij0=(i-1)*idim+j
  167. vpocha(i,j)=mcoor1.xcoor(ij)-xcoor(ij)
  168. if(mrota.ne.0) vpocha(i,j+ncb)=mrota1.xrota(ij0)-xrota(ij0)
  169. enddo
  170. enddo
  171. endif
  172. nbnn=1
  173. nbelem=n
  174. nbsous=0
  175. nbref=0
  176. segini meleme
  177. itypel=1
  178. do i=1,nbelem
  179. num(1,i)=i
  180. enddo
  181. igeoc=meleme
  182. endif
  183. segact mchpoi
  184. ** call ecchpo(mchpoi,0)
  185.  
  186. *as xfem 2010_01_13
  187. if (ierr.ne.0) then
  188. if (ichax1.ne.0) then
  189. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  190. & 'deplacement entre la config. 0 et la config. de reference'
  191. return
  192. endif
  193. endif
  194. C
  195. MMODEL = IPMODL
  196. NBPART = KMODEL(/1)
  197. IPICA = 0
  198. DO 4 IPART=1,NBPART
  199. IMODEL = KMODEL(IPART)
  200. C Pour certains modeles (OTTOSEN, UO2), les operateurs PICA et CAPI ne
  201. C doivent pas modifier les champs !
  202. * septembre 2019: cette restriction est enlevee
  203. ** IF ( INATUU.EQ.42 .OR. INATUU.EQ.108 ) IPICA = IPICA+1
  204. C Pour les modeles utilisateur UMAT, les contraintes sont deja de Cauchy
  205. C et ne doivent donc pas etre transportees !
  206. IF ( INATUU.EQ.-1) IPICA = IPICA+1
  207. C Verification presence XFEM
  208. *as xfem 2010_01_13
  209. NOBMO1=IVAMOD(/1)
  210. if (NOBMO1.ne.0) then
  211. Do iobmo1=1,NOBMO1
  212. if (TYMODE(iobmo1).eq.'MCHAML') then
  213. MCHEX1=IVAMOD(iobmo1)
  214. if (MCHEX1.TITCHE .eq. 'ENRICHIS') then
  215. ICHAX1 = MCHEX1.ICHAML(1)
  216. goto 3
  217. endif
  218. endif
  219. Enddo
  220. endif
  221. 3 CONTINUE
  222. *fin as xfem 2010_01_13
  223. 4 CONTINUE
  224.  
  225. C Presence XFEM -> pointeur ICHAX1 non nul
  226. *as xfem 2010_01_13
  227. if (ichax1.ne.0 .and. ipchp0.EQ.0) then
  228. write(ioimp,*) 'pr un deplacement enrichi, on a besoin du ',
  229. & 'deplacement entre la config. 0 et la config. de reference'
  230. CALL ERREUR(21)
  231. return
  232. endif
  233.  
  234. C IPICA = NBPART -> Le modele entier contient des modeles UMAT
  235. C Recopie MCHAML IPCHE1 tel quel et on quitte
  236. IF (IPICA.EQ.NBPART) THEN
  237. IRET = 1
  238. CALL COPIE8(IPCHE1,IPCHE2)
  239. C
  240. C Melange de MODELEs : Traitement GENERAL
  241. C
  242. ELSE
  243. IRET = 0
  244. mchelm=ipche1
  245. segact mchelm*mod
  246. if (icar.eq.0) then
  247. ** write (6,*) 'mcoors mcoord avant piocap',mcoors,mcoord,mchelm
  248. ** mcoord=mcoors
  249. mclcnf=mcoord
  250. segact mcoord
  251. nbpts=xcoor(/1)/(idim+1)
  252. CALL PIOCAP(IPMODL,IPCHE1,IPCHP1,IPCHP0,ICHAX1,IM,IDERI,
  253. & IPCHE2,IRET)
  254. mchelm=ipche2
  255. ** write (6,*) 'mclcnf mcoord apres piocap',mclcnf,mcoord,mchelm
  256. else
  257. C Mise a jour des caracteristiques materielles
  258. ** write (6,*) 'mclcnf mcoord avant formch',mclcnf,mcoord,mchelm
  259. CALL FORMCH(IPMODL,IPCHE1,IPCHP1,iret,IPCHe2)
  260. mchelm=ipche2
  261. segact mchelm*mod
  262. ** mcoord=mcoors
  263. mclcnf=mcoord
  264. ** write (6,*) 'mclcnf mcoord apres formch',mclcnf,mcoord,mchelm
  265. endif
  266. segact mcoord
  267. nbpts=xcoor(/1)/(idim+1)
  268. segdes mcoord
  269. call verrou(3)
  270. ENDIF
  271.  
  272. IF (IRET.EQ.1) THEN
  273. ** write(6,*) 'sortie de config ',ipche2
  274. CALL ACTOBJ('MCHAML ',IPCHE2,2)
  275. CALL ECROBJ('MCHAML ',IPCHE2)
  276. ENDIF
  277.  
  278. END
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  

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