Télécharger convma.eso

Retour à la liste

Numérotation des lignes :

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

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