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

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