Télécharger coml.eso

Retour à la liste

Numérotation des lignes :

  1. C COML SOURCE PV 17/12/08 21:16:29 9660
  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. typree = typdec.eq.'REAL*8'
  75. nomdec = nomche(in2)
  76. imadec = imache(in1)
  77. condec = conche(in1)
  78. ifodec = ifoche
  79. do in3 = 1, n3
  80. infdec(in3) = infche(in1,in3)
  81. enddo
  82. * write (ioimp,*) ' coml in1 in2 condec ',in1,in2,condec
  83. * segdes deche
  84. ijmel=ijmel+1
  85. if (ijmel.gt.iimel)then
  86. iimel=iimel+500
  87. segadj lilmel
  88. endif
  89. lilmel(ijmel) = deche
  90. enddo
  91. segdes mchaml
  92. enddo
  93. segdes mchelm
  94. enddo
  95. iimel=ijmel
  96. segadj lilmel
  97. ipmel = lilmel
  98. c Indice des deche pour le champ de sortie
  99. INDESO = llchee(/1) + 1
  100. c Indicateur(s) d'erreur si non nul(s)
  101. IRETOU = 0
  102.  
  103. CALL COML2(IPMODL,ipmel,INDESO,IRETOU)
  104.  
  105. c Sortie sur une erreur bloquante
  106. IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000
  107.  
  108. c Construction du MCHAML resultat : sortie normale
  109. lilmel = ipmel
  110. iga = 0
  111. n3 = 0
  112. kme = 0
  113. *
  114. DO 107 iol = 1, lilmel(/1)
  115. deche = lilmel(iol)
  116. IF (indec.EQ.INDESO) THEN
  117. iga = iga + 1
  118. if (iga.eq.1) kme = iol
  119. n3 = max(n3,infdec(/1))
  120. ELSE
  121. segsup deche
  122. lilmel(iol) = 0
  123. ENDIF
  124. 107 CONTINUE
  125.  
  126. jg = iga
  127. segini mlenti
  128. n1 = iga
  129. n2 = iga
  130. L1 = 13
  131. SEGINI,mchelm
  132. TITCHE = 'CREE PAR COMP'
  133. deche = lilmel(kme)
  134. IFOCHE = ifodec
  135. CONCHE(1) = condec
  136. IMACHE(1) = imadec
  137. DO in3 = 1, infdec(/1)
  138. INFCHE(1,in3) = infdec(in3)
  139. ENDDO
  140. SEGINI,mchaml
  141. ICHAML(1)=mchaml
  142. kga = 1
  143. iga = 0
  144. DO 108 iol = 1, lilmel(/1)
  145. deche = lilmel(iol)
  146. if (deche.eq.0) goto 108
  147. melval= ieldec
  148. IF (indec.EQ.INDESO) THEN
  149. c... compresse eventuellement le melval s il est constant
  150. CALL comred(melval)
  151.  
  152. do 120 ik=1,kga
  153. if (imadec.ne.imache(ik)) goto 120
  154. if (condec.ne.conche(ik)) goto 120
  155. DO in3 = 1, infdec(/1)
  156. if(INFCHE(ik,in3).ne.infdec(in3)) goto 120
  157. ENDDO
  158. mchaml = ichaml(ik)
  159. kme = lect(ik)
  160. kme = kme + 1
  161. NOMCHE(kme) = nomdec
  162. TYPCHE(kme) = typdec
  163. IELVAL(kme) = melval
  164. lect(ik) = kme
  165. goto 109
  166. 120 continue
  167. 130 continue
  168. kga = kga + 1
  169. c IFOCHE = ifodec
  170. CONCHE(kga) = condec
  171. IMACHE(kga) = imadec
  172. DO in3 = 1, infdec(/1)
  173. INFCHE(kga,in3) = infdec(in3)
  174. ENDDO
  175. SEGINI,mchaml
  176. ICHAML(kga)=mchaml
  177. NOMCHE(1) = nomdec
  178. TYPCHE(1) = typdec
  179. IELVAL(1) = melval
  180. lect(kga) = 1
  181. ENDIF
  182. 109 SEGDES,melval
  183. SEGSUP,deche
  184. 108 continue
  185.  
  186. n1 = kga
  187. segadj mchelm
  188. do iga = 1,n1
  189. mchaml = ichaml(iga)
  190. n2 = lect(iga)
  191. segadj mchaml
  192. segdes mchaml
  193. enddo
  194.  
  195. SEGDES,mchelm
  196. CALL ECROBJ('MCHAML ',mchelm)
  197. c write(ioimp,*) 'sortie normale de coml', mchelm
  198.  
  199. 9000 CONTINUE
  200. SEGSUP,lilmel
  201. 9010 CONTINUE
  202. SEGSUP,llchee
  203. *
  204. RETURN
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  

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