Télécharger convma.eso

Retour à la liste

Numérotation des lignes :

  1. C CONVMA SOURCE CB215821 20/11/25 13:22:08 10792
  2.  
  3. C=======================================================================
  4. C= C O N V M A =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul des flux nodaux equivalents a une condition de convection =
  10. C= forcee. Sousprogramme appele par CONVEC (convec.eso). =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= IPMODE (E) Pointeur sur le segment MMODEL =
  15. C= IPCHEL (E) Pointeur sur le segment MCHELM de CARACTERISTIQUES =
  16. C= IPCHPO (E) Pointeur sur le CHPOINT contenant la temperature =
  17. C= exterieure le long de la surface de convection =
  18. C= IPCONV (S) Pointeur sur le champ des flux equivalents =
  19. C= =
  20. C= Variables locales : =
  21. C= ------------------- =
  22. C= IPGEOM Pointeur sur un MAILLAGE elementaire du CHPOINT =
  23. C= IPOGEO Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF =
  24. C= =
  25. C= Denis ROBERT, le 28 avril 1988. =
  26. C= =
  27. C= CORRECTIONS =
  28. C= CB215821 24/02/2016 : Correction d'une erreur dans les COQx =
  29. C= Mauvaise utilisation de MATMOD =
  30. C= Ajout d'une erreur 1050 =
  31. C=======================================================================
  32.  
  33. SUBROUTINE CONVMA (IPMODE,IPCHEL,IPCHPO,IPCONV)
  34.  
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8 (A-H,O-Z)
  37.  
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC CCHAMP
  42. -INC SMCHAML
  43. -INC SMCHPOI
  44. -INC SMMODEL
  45. -INC SMELEME
  46.  
  47. logical ltelq
  48. SEGMENT MPTVAL
  49. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  50. CHARACTER*16 TYVAL(NCOSOU)
  51. ENDSEGMENT
  52. SEGMENT NOTYPE
  53. CHARACTER*16 TYPE(NBTYPE)
  54. ENDSEGMENT
  55. PARAMETER (NINF=3)
  56. INTEGER INFOS(NINF)
  57. CHARACTER*(NCONCH) CONM
  58. CHARACTER*(LOCOMP) MOCOMP,NOMATT,NOMCQ
  59. CHARACTER*10 PEAU
  60.  
  61. IPCONV=0
  62.  
  63. C 1 - QUELQUES TRANSFORMATIONS SUR LES DONNEES
  64. C ==============================================
  65. C 1.1 - Changement de support du MCHAML de caracteristiques (noeuds ->
  66. C points de Gauss) puis transformation de ce MCHAML en CHPOINT
  67. C =====
  68. C IPCHE1=0
  69. C IPCHCA=0
  70. C CALL CHASUP(IPMODE,IPCHEL,IPCHE1,iOK,1)
  71. C IF (iOK.NE.0) THEN
  72. C CALL ERREUR(iOK)
  73. C * RETURN
  74. C ENDIF
  75. C CALL CHAMPO(IPCHE1,1,IPCHCA,iOK)
  76. C CALL DTCHAM(IPCHE1)
  77. C IF (iOK.EQ.0) RETURN
  78. C =====
  79. C 1.2 - Creation d'un objet MAILLAGE contenant une seule fois tous les
  80. C points du CHPOINT IPCHPO (fusion des maillages supports de tous
  81. C les MSOUPO)
  82. C =====
  83. MCHPOI=IPCHPO
  84. SEGACT,MCHPOI
  85. MSOUPO=IPCHP(1)
  86. SEGACT,MSOUPO
  87. IPGEOM=IGEOC
  88. C SEGDES,MSOUPO
  89. DO i=2,IPCHP(/1)
  90. MSOUPO=IPCHP(i)
  91. SEGACT,MSOUPO
  92. IGEO1=IGEOC
  93. C SEGDES,MSOUPO
  94. ltelq=.false.
  95. CALL FUSE(IPGEOM,IGEO1,IRET,ltelq)
  96. IF (IERR.NE.0) GOTO 100
  97. IPGEOM=IRET
  98. ENDDO
  99. C SEGDES,MCHPOI
  100. C =====
  101. C 1.3 - Activation du MMODEL
  102. C =====
  103. MMODEL=IPMODE
  104. C SEGACT,MMODEL
  105. NSOUS=KMODEL(/1)
  106.  
  107. C 2 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou)
  108. C ========================================================
  109. C IRRT=0
  110. DO iSou=1,NSOUS
  111. iOK=0
  112. C =====
  113. C 2.1 - Activation du sous-modele (iSou)
  114. C =====
  115. IMODEL=KMODEL(iSou)
  116. SEGACT,IMODEL
  117. PEAU=' '
  118. C RECUPERATION DES CARACTERISTIQUES D'INTEGRATION
  119. NEF=NEFMOD
  120. NLG=NUMGEO(NEF)
  121. CALL TSHAPE(NLG,'GAUSS',IPINTE)
  122. IF (IERR.NE.0) THEN
  123. CALL ERREUR(251)
  124. RETURN
  125. ENDIF
  126.  
  127. IF (NEF.EQ.44.OR.NEF.EQ.27.OR.NEF.EQ.56.OR.NEF.EQ.49.OR.
  128. . NEF.EQ.41) THEN
  129. C Formulation COQx (COQ2,COQ3,COQ4,COQ6,COQ8)
  130. IF (MATMOD(/2) .LT. 3) THEN
  131. MOTERR(1:4)=NOMTP(NEF)
  132. CALL ERREUR(1050)
  133. RETURN
  134. ENDIF
  135.  
  136. PEAU=MATMOD(3)
  137. IF (PEAU .EQ. 'INFERIEURE') THEN
  138. nomatt='TINF'
  139. nomcq ='QINF'
  140. ELSEIF (PEAU .EQ. 'SUPERIEURE') THEN
  141. nomatt='TSUP'
  142. nomcq ='QSUP'
  143. ELSE
  144. MOTERR(1:8) ='MOT '
  145. MOTERR(9:16)=PEAU(1:8)
  146. CALL ERREUR(11)
  147. RETURN
  148. ENDIF
  149.  
  150. ELSE
  151. C Formulation STANDARD (pas COQx)
  152. nomatt='T '
  153. nomcq ='Q '
  154. ENDIF
  155.  
  156. C ON RECUPERE LES MAILLAGES ELEMENTAIRES DU MODELE, QUI SONT
  157. C APPUYES STRICTEMENT SUR LE CHPOINT
  158. C ITGEOM=IMAMOD
  159. C CALL ECROBJ('MAILLAGE',IPGEOM)
  160. C CALL ECRCHA('STRI')
  161. C CALL ECRCHA('APPU')
  162. C CALL ECROBJ('MAILLAGE',ITGEOM)
  163. C CALL EXTREL(IRR,0,i)
  164. C ON N'A PAS TROUVE DE MAILLAGE COMMUN A CETTE PARTIE DE
  165. C L'ENVELOPPE ET DU CHPOINT
  166. C IF (IRR.NE.0) THEN
  167. C IRRT=IRRT+1
  168. C iOK=1
  169. C GOTO 50
  170. C ENDIF
  171. C CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET)
  172. C IF (IERR.NE.0) GOTO 50
  173. C ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES
  174. C IPT3=IPOGEO
  175. C SEGACT,IPT3
  176. C ipt3=imamod
  177. C NSOU3=IPT3.LISOUS(/1)
  178. C IF (NSOU3.EQ.0) THEN
  179. C NBN2=IPT3.NUM(/1)
  180. C ENDIF
  181. C BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE
  182. C DO IMAIL=1,MAX(1,NSOU3)
  183. C iOK=0
  184. C IF (NSOU3.NE.0) THEN
  185. C IPT2=IPT3.LISOUS(IMAIL)
  186. C SEGACT,IPT2
  187. C IPOGEO=IPT2
  188. C NBN2=IPT2.NUM(/1)
  189. C SEGDES,IPT2
  190. C ENDIF
  191. C ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT
  192. C DE SOURCE ET DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO
  193.  
  194.  
  195. IPMAIL=IMAMOD
  196. CONM=CONMOD
  197. CALL CHAME1(IPMAIL,0,IPCHPO,' ',ICHELS,1)
  198. MCHEL1=ICHELS
  199. IF (IERR.NE.0) GOTO 30
  200. C SEGACT,MCHEL1
  201. MCHAM1=MCHEL1.ICHAML(1)
  202. C SEGACT,MCHAM1
  203. C recherche de la bonne composante (meme si il n'y en a qu'une, on ne sait jamais)
  204. ivfr=0
  205. DO i=1,mcham1.ielval(/1)
  206. IF (mcham1.NOMCHE(i)(1:4).EQ.nomatt) ivfr=i
  207. ENDDO
  208. IF (ivfr.EQ.0) THEN
  209. MOTERR(1:4)= nomatt
  210. MOTERR(5:30)='de TEMPERATURE exterieure'
  211. CALL ERREUR(77)
  212. RETURN
  213. ENDIF
  214. IPTEMP=MCHAM1.IELVAL(ivfr)
  215.  
  216. C RECUPERATION DU COEFFICIENT D'ECHANGE
  217. C ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT
  218. C DE CARACTERISTIQUES ET DU MAILLAGE ELEMENTAIRE IPOGEO
  219. CALL IDENT(IPMAIL,CONM,IPCHEL,0,INFOS,IOK)
  220. NBROBL=1
  221. NBRFAC=0
  222. SEGINI,NOMID
  223. LESOBL(1)='H '
  224. NBTYPE=1
  225. SEGINI,NOTYPE
  226. TYPE(1)='REAL*8'
  227. MOMATR=NOMID
  228. MOTYPE=NOTYPE
  229. CALL KOMCHA(IPCHEL,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  230. IF(IERR .NE. 0) RETURN
  231. SEGSUP,NOTYPE
  232. MPTVAL=IVAMAT
  233. IF(IVAL(/1) .LT. 1)THEN
  234. CALL ERREUR(472)
  235. RETURN
  236. ENDIF
  237. MELVAL=IVAL(1)
  238. IPCOEF=MELVAL
  239. segsup, mptval,nomid
  240.  
  241. C CALL CHAME1(IPOGEO,0,IPCHCA,' ',ICHELC,1)
  242. C MCHEL3=ICHELC
  243. C IF (IERR.NE.0) GOTO 20
  244. C SEGACT,MCHEL3
  245. C MCHAM3=MCHEL3.ICHAML(1)
  246. C SEGACT,MCHAM3
  247. C NCOELE=MCHAM3.NOMCHE(/2)
  248. C CALL PLACE(MCHAM3.NOMCHE,NCOELE,IPOSI,'H ')
  249. C IF (IPOSI.EQ.0) THEN
  250. C MOTERR(1:4)='H '
  251. C MOTERR(5:8)='CARA'
  252. C CALL ERREUR(77)
  253. C RETURN
  254. C ENDIF
  255. C IPCOEF=MCHAM3.IELVAL(IPOSI)
  256.  
  257. C PRODUIT DES SEGMENTS ELEMENTAIRES CONTENANT LA
  258. C TEMPERATURE EXTERIEURE ET LE COEFFICIENT D'ECHANGE
  259. CALL PRCHA1(IPTEMP,IPCOEF,IPSONO)
  260. C CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES
  261. L1=7
  262. N1=1
  263. N3=3
  264. SEGINI,MCHEL2
  265. MCHEL2.TITCHE='CHALEUR'
  266. MCHEL2.IMACHE(1)=IPMAIL
  267. MCHEL2.CONCHE(1)=' '
  268. C* MCHEL2.IFOCHE=IFOMOD
  269. MCHEL2.IFOCHE=IFOUR
  270. MCHEL2.INFCHE(1,3)=NIFOUR
  271. IPCHE2=MCHEL2
  272. N2=1
  273. SEGINI,MCHAM2
  274. MCHAM2.NOMCHE(1)='CHALEUR'
  275. MCHAM2.TYPCHE(1)='REAL*8'
  276. MCHEL2.ICHAML(1)=MCHAM2
  277.  
  278. C CALCUL DES FLUX NODAUX EQUIVALENTS
  279. IF (NLG.EQ.1) THEN
  280. CALL INTCN0(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  281. ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN
  282. CALL INTCN1(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  283. ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR.
  284. . NLG.EQ.10) THEN
  285. CALL INTCN2(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  286. ENDIF
  287. IF (IERR.NE.0) GOTO 10
  288. MCHAM2.IELVAL(1)=IPCHEQ
  289.  
  290. C ON TRANSFORME LE CHAMELEM EN CHPOINT
  291. CALL CHAMPO(IPCHE2,0,IPCH1,IDUM)
  292. melval=ipcheq
  293. C segsup melval
  294. IF (IERR.NE.0) GOTO 10
  295. MCHPOI=IPCH1
  296. DO i=1,IPCHP(/1)
  297. MSOUPO=IPCHP(i)
  298. segact msoupo*mod
  299. NOCOMP(1)=nomcq
  300. segact msoupo
  301. ENDDO
  302. C ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  303. IF (iSou.GT.1) THEN
  304.  
  305. CALL ADCHPO(IPCH1,IPCONV,IRET,1.D0,1.D0)
  306. CALL DTCHPO(IPCH1)
  307. CALL DTCHPO(IPCONV)
  308. C write(6,*) ' isou iret',isou,iret
  309. IF (IRET.EQ.0) GOTO 10
  310. IPCONV=IRET
  311. ELSE
  312. IPCONV=IPCH1
  313. ENDIF
  314.  
  315. CALL ACTOBJ('CHPOINT ',IPCONV,1)
  316.  
  317. iOK=1
  318. 10 SEGSUP,MCHAM2,MCHEL2
  319. 20 continue
  320. melval=ipsono
  321. segsup melval
  322. 30 continue
  323. IF (iOK.EQ.0) GOTO 40
  324. ENDDO
  325. iOK=1
  326. 40 CONTINUE
  327. IF (iOK.EQ.0) GOTO 100
  328. C ENDDO
  329.  
  330. C LES SUPPORTS GEOMETRIQUES DU CHPOINT ET DE L'OBJET MODELE
  331. C SONT INCOMPATIBLES
  332. C IF (IRRT.EQ.NSOUS) THEN
  333. C MOTERR(1:8)='MODELE '
  334. C MOTERR(9:16)='CHPOINT '
  335. C CALL ERREUR(135)
  336. C RETURN
  337. C ENDIF
  338. 100 CONTINUE
  339. C 100 CALL DTCHPO(IPCHCA)
  340.  
  341. END
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  

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