Télécharger coml.eso

Retour à la liste

Numérotation des lignes :

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

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