Télécharger condu.eso

Retour à la liste

Numérotation des lignes :

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

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