Télécharger condu.eso

Retour à la liste

Numérotation des lignes :

  1. C CONDU SOURCE CB215821 18/09/21 21:15:29 9930
  2.  
  3. SUBROUTINE CONDU
  4.  
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7.  
  8. -INC CCOPTIO
  9. -INC SMCHAML
  10. -INC SMMODEL
  11. POINTEUR MODTHR.MMODEL,MODRAY.MMODEL,MODCNV.MMODEL,MODTHM.MMODEL
  12. POINTEUR MOELEC.MMODEL,MODIFF.MMODEL
  13. -INC SMRIGID
  14.  
  15. IPRIGI = 0
  16. IPMODR = 0
  17. IPMODC = 0
  18.  
  19. C =========================================
  20. C 1- LECTURE DES ARGUMENTS DE L'OPERATEUR
  21. C =========================================
  22. C 1.1 - Lecture OBLIGATOIRE du modele (MODORI)
  23. C =====
  24. MOTERR(1:8)=' MODELE '
  25. CALL MESLIR(-137)
  26. CALL LIROBJ('MMODEL',MODORI,1,IRet)
  27. IF (IERR.NE.0) RETURN
  28. CALL ACTOBJ('MMODEL ',MODORI,1)
  29. C =====
  30. C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (MCHORI)
  31. C =====
  32. CALL MESLIR(-135)
  33. CALL LIROBJ('MCHAML',IPIN,1,IRet)
  34. IF (IERR.NE.0) RETURN
  35. CALL ACTOBJ('MCHAML ',IPIN,1)
  36. CALL REDUAF(IPIN,MODORI,MCHORI,0,IR,KER)
  37. IF(IR .NE. 1) CALL ERREUR(KER)
  38. IF(IERR .NE. 0) RETURN
  39.  
  40. C =========================================
  41. C 2- QUELQUES VERIFICATIONS DES ARGUMENTS
  42. C =========================================
  43. C 2.1 - Verification du type du champ (MCHORI)
  44. C =====
  45. MCHELM = MCHORI
  46. SEGACT,MCHELM
  47. IF (TITCHE(1:8).NE.'CARACTER') THEN
  48. SEGDES,MCHELM
  49. MOTERR(1:16) = 'CARACTERISTIQUES'
  50. CALL ERREUR(291)
  51. RETURN
  52. ENDIF
  53. C =====
  54. C 2.2 - Verification du contenu du modele (MODORI)
  55. C Separation des formulations DIFFUSION & ELECTROSTATIQUE
  56. C et des formulations THERMIQUE & THERMOHYDRIQUE
  57. C =====
  58. MMODEL = MODORI
  59. SEGACT,MMODEL
  60. NSOUS = KMODEL(/1)
  61. N1 = NSOUS
  62. SEGINI,MOELEC,MODTHM,MODRAY,MODCNV,MODTHR,MODIFF
  63. IELEC = 0
  64. ITHEM = 0
  65. IRAYE = 0
  66. ICONV = 0
  67. ITHER = 0
  68. IDIFF = 0
  69.  
  70. DO isous = 1, NSOUS
  71. IMODEL = KMODEL(isous)
  72. SEGACT,IMODEL
  73. IF (FORMOD(1).EQ.'ELECTROSTATIQUE ') THEN
  74. IELEC = IELEC + 1
  75. MOELEC.KMODEL(IELEC) = IMODEL
  76. ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE ') THEN
  77. ITHEM = ITHEM + 1
  78. MODTHM.KMODEL(ITHEM) = IMODEL
  79. ELSE IF (FORMOD(1).EQ.'DIFFUSION ') THEN
  80. IDIFF = IDIFF + 1
  81. MODIFF.KMODEL(IDIFF) = IMODEL
  82. ELSE IF (FORMOD(1).EQ.'THERMIQUE ') then
  83. NMAT = MATMOD(/2)
  84. CALL PLACE(MATMOD,NMAT,ipl,'RAYONNEMENT')
  85. IF (ipl.NE.0) THEN
  86. IRAYE = IRAYE + 1
  87. MODRAY.KMODEL(IRAYE) = IMODEL
  88. ELSE
  89. CALL PLACE(MATMOD,NMAT,ipl,'CONVECTION')
  90. IF (ipl.NE.0) THEN
  91. ICONV = ICONV + 1
  92. MODCNV.KMODEL(ICONV) = IMODEL
  93. ELSE
  94. ITHER = ITHER + 1
  95. MODTHR.KMODEL(ITHER) = IMODEL
  96. ENDIF
  97. ENDIF
  98. ELSE
  99. N1 = N1 - 1
  100. ENDIF
  101. ENDDO
  102. C Verification que le modele MODORI contient au moins un sous-modele
  103. C dont la formulation est traitee ici !
  104. IF (N1.LE.0) THEN
  105. MOTERR(1:8) = 'MMODEL '
  106. INTERR(1) = MODORI
  107. CALL ERREUR(356)
  108. GOTO 9991
  109. ENDIF
  110.  
  111. IF (IELEC.GT.0) THEN
  112. C =======================================================
  113. C 3- CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
  114. C POUR LA FORMULATION ELECTROSTATIQUE
  115. C =======================================================
  116. C Modele contenant uniquement des formulations DIFFUSION et ELECTROSTATIQUE
  117. N1 = IELEC
  118. SEGADJ,MOELEC
  119. IPMODR = MOELEC
  120. C Calcul de la matrice : tout est fait dans RIGI1
  121. ipch = 0
  122. imat = 1
  123. noer=0
  124. CALL RIGI1(IPMODR,MCHORI,ipch,imat,IPRIGI,IRET,noer)
  125. IF (IRET.NE.1) GOTO 9991
  126. MRIGID = IPRIGI
  127. ENDIF
  128.  
  129. NSOUS = ITHEM + IRAYE + ICONV + ITHER + IDIFF
  130. IF (NSOUS.GT.0) THEN
  131. C ================================================================
  132. C 4- CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
  133. C POUR LES FORMULATIONS THERMIQUE, DIFFUSION ET THERMOHYDRIQUE
  134. C ================================================================
  135. C 4.1 - Initialisation de la matrice si necessaire
  136. C =====
  137. IF (IPRIGI.EQ.0) THEN
  138. NRIGEL = 0
  139. SEGINI,MRIGID
  140. MTYMAT = 'RIGIDITE'
  141. ICHOLE = 0
  142. IMGEO1 = 0
  143. IMGEO2 = 0
  144. C* IFORIG = IFOMOD
  145. IFORIG = IFOUR
  146. ISUPEQ = 0
  147. IPRIGI = MRIGID
  148. ELSE
  149. MRIGID = IPRIGI
  150. SEGACT,MRIGID*MOD
  151. ENDIF
  152. C =====
  153. C 4.2 - Modele avec uniquement les formulations THERMIQUE, DIFFUSION et THERMOHYDRIQUE
  154. C =====
  155. N1 = NSOUS
  156. SEGINI,MMODEL
  157. isous = 0
  158. IF (ITHEM.GT.0) THEN
  159. DO i = 1, ITHEM
  160. isous = isous + 1
  161. KMODEL(isous) = MODTHM.KMODEL(i)
  162. ENDDO
  163. ENDIF
  164. IF (IRAYE.GT.0) THEN
  165. DO i = 1, IRAYE
  166. isous = isous + 1
  167. KMODEL(isous) = MODRAY.KMODEL(i)
  168. ENDDO
  169. ENDIF
  170. IF (ICONV.GT.0) THEN
  171. DO i = 1, ICONV
  172. isous = isous + 1
  173. KMODEL(isous) = MODCNV.KMODEL(i)
  174. ENDDO
  175. ENDIF
  176. IF (ITHER.GT.0) THEN
  177. DO i = 1, ITHER
  178. isous = isous + 1
  179. KMODEL(isous) = MODTHR.KMODEL(i)
  180. ENDDO
  181. ENDIF
  182. IF (IDIFF.GT.0) THEN
  183. DO i = 1, IDIFF
  184. isous = isous + 1
  185. KMODEL(isous) = MODIFF.KMODEL(i)
  186. ENDDO
  187. ENDIF
  188. IPMODC = MMODEL
  189.  
  190. C =====
  191. C 4.3 - Reduction du champ au modele precedemment reduit
  192. C =====
  193. MCHELM = MCHORI
  194. CALL REDUAF(MCHORI,IPMODC,IPCHEC,0,IRET,KERRE)
  195. SEGDES,MCHELM
  196. IF (IRET.NE.1) THEN
  197. CALL ERREUR(KERRE)
  198. GOTO 9990
  199. ENDIF
  200. ISUPCH = 0
  201. CALL QUESUP(IPMODC,IPCHEC,6,0,ISUPCH,IRET)
  202. IF (ISUPCH.GT.1) GOTO 9990
  203. C NB : La verification du support est effectuee ici pour l'instant,
  204. C car tous les formulations considerees ici s'appuient sur le
  205. C meme support (IRET = 1, 2 ou 6).
  206.  
  207. C =====
  208. C 4.4 - Remplissage de la matrice pour chaque modele concerne
  209. C =====
  210. c Formulation thermohydrique
  211. IF (ITHEM.GT.0) THEN
  212. DO i = 1, ITHEM
  213. IMODEL = MODTHM.KMODEL(i)
  214. SEGACT,IMODEL
  215. CALL THCOND(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  216. IF (IERR.NE.0) GOTO 9990
  217. ENDDO
  218. ENDIF
  219.  
  220. c Formulation rayonnement
  221. IF (IRAYE.GT.0) THEN
  222. MCHELM = IPCHEC
  223. DO i = 1, IRAYE
  224. IMODEL = MODRAY.KMODEL(i)
  225. SEGACT,IMODEL
  226. * on accepte le sous-modele de rayonnement que si le mchaml
  227. * correspondant contient une composante H !
  228. SEGACT,MCHELM
  229. imaray = IMACHE(/1)
  230. DO j = 1, imaray
  231. IF (imache(j).eq.IMAMOD .AND. conche(j).eq.CONMOD) then
  232. mchaml = ichaml(j)
  233. SEGACT,mchaml
  234. CALL PLACE(nomche,nomche(/2),ipl,'H ')
  235. IF (ipl.NE.0) then
  236. CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  237. IF (IERR.NE.0) GOTO 9990
  238. GOTO 4420
  239. ENDIF
  240. SEGDES,mchaml
  241. ENDIF
  242. ENDDO
  243. 4420 CONTINUE
  244. ENDDO
  245. SEGDES,MCHELM
  246. ENDIF
  247.  
  248. c Formulation convection
  249. IF (ICONV.GT.0) THEN
  250. DO i = 1, ICONV
  251. IMODEL = MODCNV.KMODEL(i)
  252. SEGACT,IMODEL
  253. CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  254. IF (IERR.NE.0) GOTO 9990
  255. ENDDO
  256. ENDIF
  257.  
  258. c Formulation conduction
  259. IF (ITHER.GT.0) THEN
  260. DO i = 1, ITHER
  261. IMODEL = MODTHR.KMODEL(i)
  262. SEGACT,IMODEL
  263. CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  264. IF (IERR.NE.0) GOTO 9990
  265. ENDDO
  266. ENDIF
  267.  
  268. c Formulation diffusion
  269. IF (IDIFF.GT.0) THEN
  270. DO i = 1, IDIFF
  271. IMODEL = MODIFF.KMODEL(i)
  272. SEGACT,IMODEL
  273. CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  274. IF (IERR.NE.0) GOTO 9990
  275. ENDDO
  276. ENDIF
  277. ENDIF
  278.  
  279. NRIGEL = IRIGEL(/2)
  280. IF (NRIGEL.EQ.0) THEN
  281. CALL ERREUR(19)
  282. ENDIF
  283.  
  284. 9990 CONTINUE
  285. IF (IERR.NE.0) THEN
  286. SEGSUP,MRIGID
  287. ELSE
  288. SEGDES,MRIGID
  289. CALL ECROBJ('RIGIDITE',IPRIGI)
  290. ENDIF
  291. 9991 CONTINUE
  292. MMODEL = MODORI
  293. DO isous = 1, NSOUS
  294. IMODEL = KMODEL(isous)
  295. SEGDES,IMODEL
  296. ENDDO
  297. SEGDES,MMODEL
  298. C SEGSUP,MOELEC,MODTHR,MODTHM,MODRAY,MODCNV,MODIFF
  299.  
  300. RETURN
  301. END
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  

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