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

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