Télécharger convma.eso

Retour à la liste

Numérotation des lignes :

  1. C CONVMA SOURCE CB215821 16/02/25 21:15:04 3314
  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. SEGDES,MSOUPO
  86. DO i=2,IPCHP(/1)
  87. MSOUPO=IPCHP(i)
  88. SEGACT,MSOUPO
  89. IGEO1=IGEOC
  90. 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. SEGDES,MCHPOI
  97. C =====
  98. C 1.3 - Activation du MMODEL
  99. C =====
  100. MMODEL=IPMODE
  101. 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. GOTO 50
  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. SEGACT,MCHEL1
  198. MCHAM1=MCHEL1.ICHAML(1)
  199. 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).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. GOTO 30
  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. SEGSUP,NOTYPE
  227. IF (IERR.NE.0) GOTO 20
  228. MPTVAL=IVAMAT
  229. MELVAL=IVAL(1)
  230. C IVEL1=VELCHE(/1)
  231. C IVEL2=VELCHE(/2)
  232. IPCOEF=MELVAL
  233. segsup, mptval,nomid,notype
  234.  
  235. C CALL CHAME1(IPOGEO,0,IPCHCA,' ',ICHELC,1)
  236. C MCHEL3=ICHELC
  237. C IF (IERR.NE.0) GOTO 20
  238. C SEGACT,MCHEL3
  239. C MCHAM3=MCHEL3.ICHAML(1)
  240. C SEGACT,MCHAM3
  241. C NCOELE=MCHAM3.NOMCHE(/2)
  242. C CALL PLACE(MCHAM3.NOMCHE,NCOELE,IPOSI,'H ')
  243. C IF (IPOSI.EQ.0) THEN
  244. C MOTERR(1:4)='H '
  245. C MOTERR(5:8)='CARA'
  246. C CALL ERREUR(77)
  247. C GOTO 20
  248. C ENDIF
  249. C IPCOEF=MCHAM3.IELVAL(IPOSI)
  250.  
  251. C PRODUIT DES SEGMENTS ELEMENTAIRES CONTENANT LA
  252. C TEMPERATURE EXTERIEURE ET LE COEFFICIENT D'ECHANGE
  253. CALL PRCHA1(IPTEMP,IPCOEF,IPSONO)
  254. C CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES
  255. L1=7
  256. N1=1
  257. N3=3
  258. SEGINI,MCHEL2
  259. MCHEL2.TITCHE='CHALEUR'
  260. MCHEL2.IMACHE(1)=IPMAIL
  261. MCHEL2.CONCHE(1)=' '
  262. C* MCHEL2.IFOCHE=IFOMOD
  263. MCHEL2.IFOCHE=IFOUR
  264. MCHEL2.INFCHE(1,3)=NIFOUR
  265. IPCHE2=MCHEL2
  266. N2=1
  267. SEGINI,MCHAM2
  268. MCHAM2.NOMCHE(1)='CHALEUR'
  269. MCHAM2.TYPCHE(1)='REAL*8'
  270. MCHEL2.ICHAML(1)=MCHAM2
  271.  
  272. C CALCUL DES FLUX NODAUX EQUIVALENTS
  273. IF (NLG.EQ.1) THEN
  274. CALL INTCN0(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  275. ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN
  276. CALL INTCN1(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  277. ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR.
  278. . NLG.EQ.10) THEN
  279. CALL INTCN2(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  280. ENDIF
  281. IF (IERR.NE.0) GOTO 10
  282. MCHAM2.IELVAL(1)=IPCHEQ
  283.  
  284. C ON TRANSFORME LE CHAMELEM EN CHPOINT
  285. CALL CHAMPO(IPCHE2,0,IPCH1,IDUM)
  286. melval=ipcheq
  287. segsup melval
  288. IF (IERR.NE.0) GOTO 10
  289. MCHPOI=IPCH1
  290. SEGACT,MCHPOI
  291. DO i=1,IPCHP(/1)
  292. MSOUPO=IPCHP(i)
  293. SEGACT,MSOUPO*MOD
  294. NOCOMP(1)=nomcq
  295. SEGDES,MSOUPO
  296. ENDDO
  297. SEGDES,MCHPOI
  298. C ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  299. IF (iSou.GT.1) THEN
  300.  
  301. CALL ADCHPO(IPCH1,IPCONV,IRET,1.D0,1.D0)
  302. CALL DTCHPO(IPCH1)
  303. CALL DTCHPO(IPCONV)
  304. C write(6,*) ' isou iret',isou,iret
  305. IF (IRET.EQ.0) GOTO 10
  306. IPCONV=IRET
  307. ELSE
  308. IPCONV=IPCH1
  309. ENDIF
  310. iOK=1
  311. 10 SEGSUP,MCHAM2,MCHEL2
  312. 20 continue
  313. melval=ipsono
  314. segsup melval
  315. 30 call dtchel(mchel1)
  316. IF (iOK.EQ.0) GOTO 40
  317. meleme=imamod
  318. segdes meleme
  319. segdes imodel
  320. ENDDO
  321. iOK=1
  322. 40 CONTINUE
  323. C 40 SEGDES,IPT3
  324. 50 SEGDES,IMODEL
  325. IF (iOK.EQ.0) GOTO 100
  326. C ENDDO
  327.  
  328. C LES SUPPORTS GEOMETRIQUES DU CHPOINT ET DE L'OBJET MODELE
  329. C SONT INCOMPATIBLES
  330. C IF (IRRT.EQ.NSOUS) THEN
  331. C MOTERR(1:8)='MODELE '
  332. C MOTERR(9:16)='CHPOINT '
  333. C CALL ERREUR(135)
  334. C ENDIF
  335. 100 CONTINUE
  336. C 100 CALL DTCHPO(IPCHCA)
  337. SEGDES,MMODEL
  338.  
  339. RETURN
  340. END
  341.  
  342.  
  343.  

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