Télécharger coml.eso

Retour à la liste

Numérotation des lignes :

coml
  1. C COML SOURCE JK148537 23/08/21 21:15:09 11723
  2.  
  3. SUBROUTINE COML
  4.  
  5. *-----------------------------------------------------------------------
  6. * INTEGRATION DES LOIS DE COMPORTEMENT
  7. *-----------------------------------------------------------------------
  8. * SYNTAXE
  9. * CHES1 = 'COMP' MODL CHET1 CHET2 ;
  10. *
  11. * MMODEL | MODL OBJET MODELE
  12. * |
  13. * MCHAML | CHET1 par exemple : contraintes, phases,
  14. * | caracteristiques, variables internes, temperatures
  15. * | rassemblees dans le champ pour un etat
  16. * | initial
  17. * MCHAML | CHET2 : idem etat final
  18. * on entre ce dont on a besoin
  19. * on sort ce qui doit
  20. *
  21. * Ne concerne que les formulations MECANIQUE, POREUX, MELANGE, LIAISON
  22. * DIFFUSION et METALLURGIE.
  23. *-----------------------------------------------------------------------
  24.  
  25. IMPLICIT INTEGER (I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC SMLENTI
  31. -INC SMCHAML
  32. -INC SMMODEL
  33. -INC SMCOORD
  34. -INC DECHE
  35. C POINTEUR DES MCHEML EN ENTREE
  36. SEGMENT llchee(NNN)
  37. SEGMENT LIMODE(NSM)
  38. C
  39. C =================================================================
  40. C LECTURE D'UN MMODEL
  41. C =================================================================
  42. CALL LIROBJ('MMODEL ',IPMODL,1,irt)
  43. CALL ACTOBJ('MMODEL ',IPMODL,1)
  44. IF (IERR.NE.0) RETURN
  45. C
  46. C DEROULER LE MMODEL POUR NE SELECTIONNER QUE CEUX D'INTERET
  47. MMODEL = IPMODL
  48. NSOUS = KMODEL(/1)
  49. NSM = NSOUS
  50. SEGINI,LIMODE
  51. c
  52. NLIMOD = 0
  53. NMOMEL = 0
  54. DO IM = 1, NSOUS
  55. IMODEL = KMODEL(IM)
  56. IF (FORMOD(1)(1:16).EQ.'MECANIQUE ' .OR.
  57. & FORMOD(1)(1:16).EQ.'LIQUIDE ' .OR.
  58. & FORMOD(1)(1:16).EQ.'POREUX ' .OR.
  59. & FORMOD(1)(1:16).EQ.'LIAISON ' .OR.
  60. & FORMOD(1)(1:16).EQ.'DIFFUSION ' .OR.
  61. & FORMOD(1)(1:16).EQ.'METALLURGIE ' ) THEN
  62. NLIMOD = NLIMOD+1
  63. IF (NLIMOD.GT.NSM) THEN
  64. NSM = NSM * 2
  65. SEGADJ LIMODE
  66. ENDIF
  67. LIMODE(NLIMOD) = IMODEL
  68. ELSE IF (FORMOD(1)(1:16).EQ. 'MELANGE ') THEN
  69. NLIMOD = NLIMOD+1
  70. IF (NLIMOD.GT.NSM) THEN
  71. NSM = NSM * 2
  72. SEGADJ LIMODE
  73. ENDIF
  74. LIMODE(NLIMOD) = IMODEL
  75. nmomel = nmomel + 1
  76. IF (MATMOD(1)(1:6).NE.'SERIE ') THEN
  77. IF (IVAMOD(/1).GE.1) THEN
  78. DO IVM1 = 1,IVAMOD(/1)
  79. IF (TYMODE(IVM1).EQ.'IMODEL ') THEN
  80. IMODE1 = IVAMOD(IVM1)
  81. NLIMOD = NLIMOD+1
  82. IF (NLIMOD.GT.NSM) THEN
  83. NSM = NSM * 2
  84. SEGADJ LIMODE
  85. ENDIF
  86. LIMODE(NLIMOD) = IMODE1
  87. ENDIF
  88. ENDDO
  89. ENDIF
  90. ENDIF
  91. ENDIF
  92. ENDDO
  93. C
  94. IF (NLIMOD.LE.0) THEN
  95. WRITE(IOIMP,*) 'ERREUR ANORMALE : MMODEL VIDE !'
  96. CALL ERREUR(5)
  97. RETURN
  98. ENDIF
  99. C
  100. C TEST DE NON REDONDANCE DES SOUS-MODELES
  101. N1 = 1
  102. DO 1161 IT1 = NLIMOD, 2, -1
  103. IMODE1 = LIMODE(IT1)
  104. DO IT2 = (IT1 - 1), 1, -1
  105. IMODE2 = LIMODE(IT2)
  106. IF (IMODE1.EQ.IMODE2) THEN
  107. LIMODE(IT1) = 0
  108. GOTO 1161
  109. ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND.
  110. & IMODE1.CONMOD(1:LCONMO).EQ.IMODE2.CONMOD(1:LCONMO)) THEN
  111. LIMODE(IT1) = 0
  112. GOTO 1161
  113. ENDIF
  114. ENDDO
  115. N1 = N1 + 1
  116. 1161 CONTINUE
  117. C
  118. C CREATION DU MMODEL DE TRAVAIL (les sous-modeles de formulation
  119. C melange sont mis a la fin pour qu'ils soient traites en dernier
  120. C car ils dependent des resultats des autres sous-modeles)
  121. SEGINI,MMODEL
  122. IT1 = 0
  123. IT2 = N1 - NMOMEL
  124. DO IM = 1, NLIMOD
  125. IMODEL = LIMODE(IM)
  126. IF (IMODEL.GT.0) THEN
  127. IF (FORMOD(1)(1:8).NE.'MELANGE ') THEN
  128. IT1 = IT1 + 1
  129. KMODEL(IT1) = IMODEL
  130. ELSE
  131. IT2 = IT2 + 1
  132. KMODEL(IT2) = IMODEL
  133. ENDIF
  134. ENDIF
  135. ENDDO
  136. SEGSUP,LIMODE
  137. IPMODL=MMODEL
  138. C
  139. C =================================================================
  140. C LECTURE DES MCHAML (AU MOINS UN)
  141. C =================================================================
  142. NNN = 2
  143. SEGINI,llchee
  144. LACOND = 1
  145. NBCHEE = 0
  146. 50 CONTINUE
  147. CALL LIROBJ('MCHAML ',ipche1,LACOND,irt)
  148. IF (IERR.NE.0) GOTO 9010
  149. IF (irt.eq.1) THEN
  150. NBCHEE=NBCHEE+1
  151. IF(NBCHEE .GT. NNN)THEN
  152. NNN=NBCHEE*2+10
  153. SEGADJ,llchee
  154. ENDIF
  155. CALL ACTOBJ('MCHAML ',ipche1,1)
  156. IF (IERR.NE.0) GOTO 9010
  157. CALL REDUAF(ipche1,ipmodl,ipch,0,iret,kerr)
  158. IF (iret.NE.1) CALL ERREUR(kerr)
  159. IF (IERR.NE.0) GOTO 9010
  160. llchee(NBCHEE) = ipch
  161. LACOND = 0
  162. GOTO 50
  163. ENDIF
  164. C
  165. C =================================================================
  166. C CREATION DES DECHE
  167. C =================================================================
  168. iimel = 500
  169. CALL oooprl(1)
  170. C On a besoin du MCOORD plus loin dans doxe.eso
  171. segact,mcoord
  172. segini,lilmel
  173. ijmel=0
  174. do iem = 1, NBCHEE
  175. mchelm = llchee(iem)
  176. n1 = conche(/2)
  177. n3 = infche(/2)
  178. do in1 = 1, n1
  179. mchaml = ichaml(in1)
  180. n2 = nomche(/2)
  181. do in2 = 1, n2
  182. segini deche
  183. indec = iem
  184. ieldec = -1*ielval(in2)
  185. typdec = typche(in2)
  186. typree = typdec(1:6).eq.'REAL*8'
  187. nomdec = nomche(in2)
  188. imadec = imache(in1)
  189. condec = conche(in1)
  190. ifodec = ifoche
  191. do in3 = 1, n3
  192. infdec(in3) = infche(in1,in3)
  193. enddo
  194. * write (ioimp,*) ' coml in1 in2 condec ',in1,in2,condec
  195. ijmel=ijmel+1
  196. if (ijmel.gt.iimel)then
  197. iimel=iimel+500
  198. segadj lilmel
  199. endif
  200. lilmel(ijmel) = deche
  201. enddo
  202. enddo
  203. enddo
  204. iimel=ijmel
  205. segadj lilmel
  206. CALL oooprl(0)
  207. ipmel= lilmel
  208. C
  209. C =================================================================
  210. C Indice des deche pour le champ de sortie
  211. INDESO = NBCHEE + 1
  212. C
  213. C Indicateur(s) d'erreur si non nul(s)
  214. IRETOU = 0
  215. C
  216. CALL COML2(IPMODL,ipmel,INDESO,IRETOU)
  217. C
  218. C =================================================================
  219. C Sortie sur une erreur bloquante
  220. IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000
  221. C
  222. C Construction du MCHAML resultat : sortie normale
  223. lilmel = ipmel
  224. iga = 0
  225. n3 = 0
  226. kme = 0
  227. *
  228. DO 107 iol = 1, lilmel(/1)
  229. deche = lilmel(iol)
  230. IF (indec.EQ.INDESO) THEN
  231. iga = iga + 1
  232. if (iga.eq.1) kme = iol
  233. n3 = max(n3,infdec(/1))
  234. ELSE
  235. segsup deche
  236. lilmel(iol) = 0
  237. ENDIF
  238. 107 CONTINUE
  239.  
  240. call oooprl(1)
  241. jg = iga
  242. segini mlenti
  243. n1 = iga
  244. n2 = iga
  245. L1 = 13
  246. SEGINI,mchelm
  247. TITCHE = 'CREE PAR COMP'
  248. deche = lilmel(kme)
  249. IFOCHE = ifodec
  250. CONCHE(1) = condec
  251. IMACHE(1) = imadec
  252. DO in3 = 1, infdec(/1)
  253. INFCHE(1,in3) = infdec(in3)
  254. ENDDO
  255. SEGINI,mchaml
  256. ICHAML(1)=mchaml
  257. kga = 1
  258. iga = 0
  259. DO 108 iol = 1, lilmel(/1)
  260. deche = lilmel(iol)
  261. if (deche.eq.0) goto 108
  262. melval=ABS(ieldec)
  263. IF (indec.EQ.INDESO) THEN
  264. c... compresse eventuellement le melval s il est constant
  265. CALL comred(melval)
  266.  
  267. do 120 ik=1,kga
  268. if (imadec.ne.imache(ik)) goto 120
  269. if (condec(1:LCONMO).ne.conche(ik)(1:NCONCH)) goto 120
  270. DO in3 = 1, infdec(/1)
  271. if(INFCHE(ik,in3).ne.infdec(in3)) goto 120
  272. ENDDO
  273. mchaml = ichaml(ik)
  274. kme = lect(ik)
  275. kme = kme + 1
  276. NOMCHE(kme) = nomdec
  277. TYPCHE(kme) = typdec
  278. IELVAL(kme) = melval
  279. lect(ik) = kme
  280. goto 109
  281. 120 continue
  282. kga = kga + 1
  283. c IFOCHE = ifodec
  284. CONCHE(kga) = condec
  285. IMACHE(kga) = imadec
  286. DO in3 = 1, infdec(/1)
  287. INFCHE(kga,in3) = infdec(in3)
  288. ENDDO
  289. SEGINI,mchaml
  290. ICHAML(kga)=mchaml
  291. NOMCHE(1) = nomdec
  292. TYPCHE(1) = typdec
  293. IELVAL(1) = melval
  294. lect(kga) = 1
  295. ENDIF
  296. 109 CONTINUE
  297. SEGSUP,deche
  298. 108 continue
  299.  
  300. n1 = kga
  301. segadj mchelm
  302. do iga = 1,n1
  303. mchaml = ichaml(iga)
  304. n2 = lect(iga)
  305. segadj mchaml
  306. enddo
  307. segdes,mcoord
  308. call oooprl(0)
  309. C
  310. CALL ACTOBJ('MCHAML ',mchelm,1)
  311. CALL ECROBJ('MCHAML ',mchelm)
  312. c write(ioimp,*) 'sortie normale de coml', mchelm
  313.  
  314. 9000 CONTINUE
  315. MMODEL=IPMODL
  316. SEGSUP,MMODEL
  317. SEGSUP,lilmel
  318. 9010 CONTINUE
  319. SEGSUP,llchee
  320.  
  321. END
  322.  
  323.  
  324.  

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