Télécharger coml.eso

Retour à la liste

Numérotation des lignes :

  1. C COML SOURCE BP208322 17/03/01 21:16:09 9325
  2.  
  3. SUBROUTINE COML
  4.  
  5. *-----------------------------------------------------------------------
  6. * CALCUL COMPORTEMENTS LOCAUX
  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.  
  22. IMPLICIT INTEGER (I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC CCOPTIO
  26. -INC SMLENTI
  27. -INC SMCHAML
  28. -INC SMMODEL
  29. -INC DECHE
  30. * pointeur des mcheml en entree
  31. SEGMENT llchee(0)
  32. *
  33. * LECTURE D'UN MODEL
  34. *
  35. CALL LIROBJ('MMODEL',IPMODL,1,irt)
  36. IF (IERR.NE.0) RETURN
  37. *
  38. * Lecture des mchaml (au moins un)
  39. *
  40. SEGINI,llchee
  41. LACOND = 1
  42. 50 CONTINUE
  43. CALL LIROBJ('MCHAML',ipche1,LACOND,irt)
  44. IF (IERR.NE.0) GOTO 9010
  45. IF (irt.ne.0) THEN
  46. * appel a redu pour rendre compatible le mchaml et le mmodel
  47. CALL REDUAF(ipche1,ipmodl,ipch,0,iret,kerr)
  48. IF (iret.NE.1) CALL ERREUR(kerr)
  49. IF (IERR.NE.0) GOTO 9010
  50. llchee(**) = ipch
  51. LACOND = 0
  52. GOTO 50
  53. ENDIF
  54.  
  55. c Pile des melval sous forme de deche
  56. c mise en place du tableau des pointeurs sur les melval : deche
  57. iimel = 500
  58. segini,lilmel
  59. ijmel=0
  60. do iem = 1, llchee(/1)
  61. mchelm = llchee(iem)
  62. segact mchelm
  63. n1 = conche(/2)
  64. n3 = infche(/2)
  65. do in1 = 1, n1
  66. mchaml = ichaml(in1)
  67. segact mchaml
  68. n2 = nomche(/2)
  69. do in2 = 1, n2
  70. segini deche
  71. indec = iem
  72. ieldec = ielval(in2)
  73. typdec = typche(in2)
  74. nomdec = nomche(in2)
  75. imadec = imache(in1)
  76. condec = conche(in1)
  77. ifodec = ifoche
  78. do in3 = 1, n3
  79. infdec(in3) = infche(in1,in3)
  80. enddo
  81. * write (ioimp,*) ' coml in1 in2 condec ',in1,in2,condec
  82. * segdes deche
  83. ijmel=ijmel+1
  84. if (ijmel.gt.iimel)then
  85. iimel=iimel+500
  86. segadj lilmel
  87. endif
  88. lilmel(ijmel) = deche
  89. enddo
  90. segdes mchaml
  91. enddo
  92. segdes mchelm
  93. enddo
  94. iimel=ijmel
  95. segadj lilmel
  96. ipmel = lilmel
  97. c Indice des deche pour le champ de sortie
  98. INDESO = llchee(/1) + 1
  99. c Indicateur(s) d'erreur si non nul(s)
  100. IRETOU = 0
  101.  
  102. CALL COML2(IPMODL,ipmel,INDESO,IRETOU)
  103.  
  104. c Sortie sur une erreur bloquante
  105. IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000
  106.  
  107. c Construction du MCHAML resultat : sortie normale
  108. lilmel = ipmel
  109. iga = 0
  110. n3 = 0
  111. kme = 0
  112. *
  113. DO 107 iol = 1, lilmel(/1)
  114. deche = lilmel(iol)
  115. IF (indec.EQ.INDESO) THEN
  116. iga = iga + 1
  117. if (iga.eq.1) kme = iol
  118. n3 = max(n3,infdec(/1))
  119. ELSE
  120. segsup deche
  121. lilmel(iol) = 0
  122. ENDIF
  123. 107 CONTINUE
  124.  
  125. jg = iga
  126. segini mlenti
  127. n1 = iga
  128. n2 = iga
  129. L1 = 13
  130. SEGINI,mchelm
  131. TITCHE = 'CREE PAR COMP'
  132. deche = lilmel(kme)
  133. IFOCHE = ifodec
  134. CONCHE(1) = condec
  135. IMACHE(1) = imadec
  136. DO in3 = 1, infdec(/1)
  137. INFCHE(1,in3) = infdec(in3)
  138. ENDDO
  139. SEGINI,mchaml
  140. ICHAML(1)=mchaml
  141. kga = 1
  142. iga = 0
  143. DO 108 iol = 1, lilmel(/1)
  144. deche = lilmel(iol)
  145. if (deche.eq.0) goto 108
  146. melval= ieldec
  147. IF (indec.EQ.INDESO) THEN
  148. c... compresse eventuellement le melval s il est constant
  149. CALL comred(melval)
  150.  
  151. do 120 ik=1,kga
  152. if (imadec.ne.imache(ik)) goto 120
  153. if (condec.ne.conche(ik)) goto 120
  154. DO in3 = 1, infdec(/1)
  155. if(INFCHE(ik,in3).ne.infdec(in3)) goto 120
  156. ENDDO
  157. mchaml = ichaml(ik)
  158. kme = lect(ik)
  159. kme = kme + 1
  160. NOMCHE(kme) = nomdec
  161. TYPCHE(kme) = typdec
  162. IELVAL(kme) = melval
  163. lect(ik) = kme
  164. goto 109
  165. 120 continue
  166. 130 continue
  167. kga = kga + 1
  168. c IFOCHE = ifodec
  169. CONCHE(kga) = condec
  170. IMACHE(kga) = imadec
  171. DO in3 = 1, infdec(/1)
  172. INFCHE(kga,in3) = infdec(in3)
  173. ENDDO
  174. SEGINI,mchaml
  175. ICHAML(kga)=mchaml
  176. NOMCHE(1) = nomdec
  177. TYPCHE(1) = typdec
  178. IELVAL(1) = melval
  179. lect(kga) = 1
  180. ENDIF
  181. 109 SEGDES,melval
  182. SEGSUP,deche
  183. 108 continue
  184.  
  185. n1 = kga
  186. segadj mchelm
  187. do iga = 1,n1
  188. mchaml = ichaml(iga)
  189. n2 = lect(iga)
  190. segadj mchaml
  191. segdes mchaml
  192. enddo
  193.  
  194. SEGDES,mchelm
  195. CALL ECROBJ('MCHAML ',mchelm)
  196. c write(ioimp,*) 'sortie normale de coml', mchelm
  197.  
  198. 9000 CONTINUE
  199. SEGSUP,lilmel
  200. 9010 CONTINUE
  201. SEGSUP,llchee
  202. *
  203. RETURN
  204. END
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  

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