Télécharger convma.eso

Retour à la liste

Numérotation des lignes :

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

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