Télécharger condu.eso

Retour à la liste

Numérotation des lignes :

  1. C CONDU SOURCE PV 20/03/30 21:16:34 10567
  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. -INC SMCOORD
  15.  
  16. segact mcoord
  17. IPRIGI = 0
  18. IPMODR = 0
  19. IPMODC = 0
  20.  
  21. C =========================================
  22. C 1- LECTURE DES ARGUMENTS DE L'OPERATEUR
  23. C =========================================
  24. C 1.1 - Lecture OBLIGATOIRE du modele (MODORI)
  25. C =====
  26. MOTERR(1:8)=' MODELE '
  27. CALL MESLIR(-137)
  28. CALL LIROBJ('MMODEL ',MODORI,1,IRet)
  29. CALL ACTOBJ('MMODEL ',MODORI,1)
  30. IF (IERR.NE.0) RETURN
  31. C =====
  32. C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (MCHORI)
  33. C =====
  34. CALL MESLIR(-135)
  35. CALL LIROBJ('MCHAML ',IPIN,1,IRet)
  36. CALL ACTOBJ('MCHAML ',IPIN,1)
  37. IF (IERR.NE.0) RETURN
  38. CALL REDUAF(IPIN,MODORI,MCHORI,0,IR,KER)
  39. IF(IR .NE. 1) CALL ERREUR(KER)
  40. IF(IERR .NE. 0) RETURN
  41.  
  42. C =========================================
  43. C 2- QUELQUES VERIFICATIONS DES ARGUMENTS
  44. C =========================================
  45. C 2.1 - Verification du type du champ (MCHORI)
  46. C =====
  47. MCHELM = MCHORI
  48. SEGACT,MCHELM
  49. IF (TITCHE(1:8).NE.'CARACTER') THEN
  50. MOTERR(1:16) = 'CARACTERISTIQUES'
  51. CALL ERREUR(291)
  52. RETURN
  53. ENDIF
  54. C =====
  55. C 2.2 - Verification du contenu du modele (MODORI)
  56. C Separation des formulations DIFFUSION & ELECTROSTATIQUE
  57. C et des formulations THERMIQUE & THERMOHYDRIQUE
  58. C =====
  59. MMODEL = MODORI
  60. SEGACT,MMODEL
  61. NSOUS = KMODEL(/1)
  62. N1 = NSOUS
  63. SEGINI,MOELEC,MODTHM,MODRAY,MODCNV,MODTHR,MODIFF
  64. IELEC = 0
  65. ITHEM = 0
  66. IRAYE = 0
  67. ICONV = 0
  68. ITHER = 0
  69. IDIFF = 0
  70.  
  71. DO isous = 1, NSOUS
  72. IMODEL = KMODEL(isous)
  73. SEGACT,IMODEL
  74. IF (FORMOD(1).EQ.'ELECTROSTATIQUE ') THEN
  75. IELEC = IELEC + 1
  76. MOELEC.KMODEL(IELEC) = IMODEL
  77. ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE ') THEN
  78. ITHEM = ITHEM + 1
  79. MODTHM.KMODEL(ITHEM) = IMODEL
  80. ELSE IF (FORMOD(1).EQ.'DIFFUSION ') THEN
  81. IDIFF = IDIFF + 1
  82. MODIFF.KMODEL(IDIFF) = IMODEL
  83. ELSE IF (FORMOD(1).EQ.'THERMIQUE ') then
  84. NMAT = MATMOD(/2)
  85. CALL PLACE(MATMOD,NMAT,ipl,'RAYONNEMENT')
  86. IF (ipl.NE.0) THEN
  87. IRAYE = IRAYE + 1
  88. MODRAY.KMODEL(IRAYE) = IMODEL
  89. ELSE
  90. CALL PLACE(MATMOD,NMAT,ipl,'CONVECTION')
  91. IF (ipl.NE.0) THEN
  92. ICONV = ICONV + 1
  93. MODCNV.KMODEL(ICONV) = IMODEL
  94. ELSE
  95. ITHER = ITHER + 1
  96. MODTHR.KMODEL(ITHER) = IMODEL
  97. ENDIF
  98. ENDIF
  99. ELSE
  100. N1 = N1 - 1
  101. ENDIF
  102. ENDDO
  103. C Verification que le modele MODORI contient au moins un sous-modele
  104. C dont la formulation est traitee ici !
  105. IF (N1.LE.0) THEN
  106. MOTERR(1:8) = 'MMODEL '
  107. INTERR(1) = MODORI
  108. CALL ERREUR(356)
  109. GOTO 9991
  110. ENDIF
  111.  
  112. IF (IELEC.GT.0) THEN
  113. C =======================================================
  114. C 3- CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
  115. C POUR LA FORMULATION ELECTROSTATIQUE
  116. C =======================================================
  117. C Modele contenant uniquement des formulations DIFFUSION et ELECTROSTATIQUE
  118. N1 = IELEC
  119. SEGADJ,MOELEC
  120. IPMODR = MOELEC
  121. C Calcul de la matrice : tout est fait dans RIGI1
  122. ipch = 0
  123. imat = 1
  124. noer=0
  125. CALL RIGI1(IPMODR,MCHORI,ipch,imat,IPRIGI,IRET,noer)
  126. IF (IRET.NE.1) GOTO 9991
  127. MRIGID = IPRIGI
  128. ENDIF
  129.  
  130. NSOUS = ITHEM + IRAYE + ICONV + ITHER + IDIFF
  131. IF (NSOUS.GT.0) THEN
  132. C ================================================================
  133. C 4- CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
  134. C POUR LES FORMULATIONS THERMIQUE, DIFFUSION ET THERMOHYDRIQUE
  135. C ================================================================
  136. C 4.1 - Initialisation de la matrice si necessaire
  137. C =====
  138. IF (IPRIGI.EQ.0) THEN
  139. NRIGEL = 0
  140. SEGINI,MRIGID
  141. MTYMAT = 'RIGIDITE'
  142. ICHOLE = 0
  143. IMGEO1 = 0
  144. IMGEO2 = 0
  145. C* IFORIG = IFOMOD
  146. IFORIG = IFOUR
  147. ISUPEQ = 0
  148. IPRIGI = MRIGID
  149. ELSE
  150. MRIGID = IPRIGI
  151. SEGACT,MRIGID*MOD
  152. ENDIF
  153. C =====
  154. C 4.2 - Modele avec uniquement les formulations THERMIQUE, DIFFUSION et THERMOHYDRIQUE
  155. C =====
  156. N1 = NSOUS
  157. SEGINI,MMODEL
  158. isous = 0
  159. IF (ITHEM.GT.0) THEN
  160. DO i = 1, ITHEM
  161. isous = isous + 1
  162. KMODEL(isous) = MODTHM.KMODEL(i)
  163. ENDDO
  164. ENDIF
  165. IF (IRAYE.GT.0) THEN
  166. DO i = 1, IRAYE
  167. isous = isous + 1
  168. KMODEL(isous) = MODRAY.KMODEL(i)
  169. ENDDO
  170. ENDIF
  171. IF (ICONV.GT.0) THEN
  172. DO i = 1, ICONV
  173. isous = isous + 1
  174. KMODEL(isous) = MODCNV.KMODEL(i)
  175. ENDDO
  176. ENDIF
  177. IF (ITHER.GT.0) THEN
  178. DO i = 1, ITHER
  179. isous = isous + 1
  180. KMODEL(isous) = MODTHR.KMODEL(i)
  181. ENDDO
  182. ENDIF
  183. IF (IDIFF.GT.0) THEN
  184. DO i = 1, IDIFF
  185. isous = isous + 1
  186. KMODEL(isous) = MODIFF.KMODEL(i)
  187. ENDDO
  188. ENDIF
  189. IPMODC = MMODEL
  190.  
  191. C =====
  192. C 4.3 - Reduction du champ au modele precedemment reduit
  193. C =====
  194. MCHELM = MCHORI
  195. CALL REDUAF(MCHORI,IPMODC,IPCHEC,0,IRET,KERRE)
  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. ENDIF
  241. ENDDO
  242. 4420 CONTINUE
  243. ENDDO
  244. ENDIF
  245.  
  246. c Formulation convection
  247. IF (ICONV.GT.0) THEN
  248. DO i = 1, ICONV
  249. IMODEL = MODCNV.KMODEL(i)
  250. SEGACT,IMODEL
  251. CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  252. IF (IERR.NE.0) GOTO 9990
  253. ENDDO
  254. ENDIF
  255.  
  256. c Formulation conduction
  257. IF (ITHER.GT.0) THEN
  258. DO i = 1, ITHER
  259. IMODEL = MODTHR.KMODEL(i)
  260. SEGACT,IMODEL
  261. CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  262. IF (IERR.NE.0) GOTO 9990
  263. ENDDO
  264. ENDIF
  265.  
  266. c Formulation diffusion
  267. IF (IDIFF.GT.0) THEN
  268. DO i = 1, IDIFF
  269. IMODEL = MODIFF.KMODEL(i)
  270. SEGACT,IMODEL
  271. CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
  272. IF (IERR.NE.0) GOTO 9990
  273. ENDDO
  274. ENDIF
  275. ENDIF
  276.  
  277. NRIGEL = IRIGEL(/2)
  278. IF (NRIGEL.EQ.0) THEN
  279. CALL ERREUR(19)
  280. ENDIF
  281.  
  282. 9990 CONTINUE
  283. IF (IERR.NE.0) THEN
  284. SEGSUP,MRIGID
  285. ELSE
  286. SEGDES,MRIGID
  287. CALL ECROBJ('RIGIDITE',IPRIGI)
  288. ENDIF
  289. 9991 CONTINUE
  290. C SEGSUP,MOELEC,MODTHR,MODTHM,MODRAY,MODCNV,MODIFF
  291.  
  292. END
  293.  
  294.  
  295.  
  296.  

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