Télécharger coml.eso

Retour à la liste

Numérotation des lignes :

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

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