Télécharger convma.eso

Retour à la liste

Numérotation des lignes :

convma
  1. C CONVMA SOURCE CB215821 21/02/11 21:15:08 10886
  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. IPMAIL=IMAMOD
  157. CONM=CONMOD
  158. CALL CHAME1(IPMAIL,0,IPCHPO,' ',ICHELS,1)
  159. MCHEL1=ICHELS
  160. IF (IERR.NE.0) GOTO 30
  161. C SEGACT,MCHEL1
  162. MCHAM1=MCHEL1.ICHAML(1)
  163. C SEGACT,MCHAM1
  164. C recherche de la bonne composante (meme si il n'y en a qu'une, on ne sait jamais)
  165. ivfr=0
  166. DO i=1,mcham1.ielval(/1)
  167. IF (mcham1.NOMCHE(i)(1:4).EQ.nomatt) ivfr=i
  168. ENDDO
  169. IF (ivfr.EQ.0) THEN
  170. MOTERR(1:4)= nomatt
  171. MOTERR(5:30)='de TEMPERATURE exterieure'
  172. CALL ERREUR(77)
  173. RETURN
  174. ENDIF
  175. IPTEMP=MCHAM1.IELVAL(ivfr)
  176.  
  177. C RECUPERATION DU COEFFICIENT D'ECHANGE
  178. C ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT
  179. C DE CARACTERISTIQUES ET DU MAILLAGE ELEMENTAIRE IPOGEO
  180. CALL IDENT(IPMAIL,CONM,IPCHEL,0,INFOS,IOK)
  181. NBROBL=1
  182. NBRFAC=0
  183. SEGINI,NOMID
  184. LESOBL(1)='H '
  185. NBTYPE=1
  186. SEGINI,NOTYPE
  187. TYPE(1)='REAL*8'
  188. MOMATR=NOMID
  189. MOTYPE=NOTYPE
  190. CALL KOMCHA(IPCHEL,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  191. IF(IERR .NE. 0) RETURN
  192. SEGSUP,NOTYPE
  193. MPTVAL=IVAMAT
  194. IF(IVAL(/1) .LT. 1)THEN
  195. CALL ERREUR(472)
  196. RETURN
  197. ENDIF
  198. MELVAL=IVAL(1)
  199. IPCOEF=MELVAL
  200. segsup, mptval,nomid
  201.  
  202. C CALL CHAME1(IPOGEO,0,IPCHCA,' ',ICHELC,1)
  203. C MCHEL3=ICHELC
  204. C IF (IERR.NE.0) GOTO 20
  205. C SEGACT,MCHEL3
  206. C MCHAM3=MCHEL3.ICHAML(1)
  207. C SEGACT,MCHAM3
  208. C NCOELE=MCHAM3.NOMCHE(/2)
  209. C CALL PLACE(MCHAM3.NOMCHE,NCOELE,IPOSI,'H ')
  210. C IF (IPOSI.EQ.0) THEN
  211. C MOTERR(1:4)='H '
  212. C MOTERR(5:8)='CARA'
  213. C CALL ERREUR(77)
  214. C RETURN
  215. C ENDIF
  216. C IPCOEF=MCHAM3.IELVAL(IPOSI)
  217.  
  218. C PRODUIT DES SEGMENTS ELEMENTAIRES CONTENANT LA
  219. C TEMPERATURE EXTERIEURE ET LE COEFFICIENT D'ECHANGE
  220. CALL PRCHA1(IPTEMP,IPCOEF,IPSONO)
  221. C CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES
  222. L1=7
  223. N1=1
  224. N3=3
  225. SEGINI,MCHEL2
  226. MCHEL2.TITCHE='CHALEUR'
  227. MCHEL2.IMACHE(1)=IPMAIL
  228. MCHEL2.CONCHE(1)=' '
  229. C* MCHEL2.IFOCHE=IFOMOD
  230. MCHEL2.IFOCHE=IFOUR
  231. MCHEL2.INFCHE(1,3)=NIFOUR
  232. IPCHE2=MCHEL2
  233. N2=1
  234. SEGINI,MCHAM2
  235. MCHAM2.NOMCHE(1)='CHALEUR'
  236. MCHAM2.TYPCHE(1)='REAL*8'
  237. MCHEL2.ICHAML(1)=MCHAM2
  238.  
  239. C CALCUL DES FLUX NODAUX EQUIVALENTS
  240. IF (NLG.EQ.1) THEN
  241. CALL INTCN0(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  242. ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN
  243. CALL INTCN1(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  244. ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR.
  245. . NLG.EQ.10) THEN
  246. CALL INTCN2(IPSONO,IPMAIL,IPINTE,IPCHEQ)
  247. ENDIF
  248. IF (IERR.NE.0) GOTO 10
  249. MCHAM2.IELVAL(1)=IPCHEQ
  250.  
  251. C ON TRANSFORME LE CHAMELEM EN CHPOINT
  252. CALL CHAMPO(IPCHE2,0,IPCH1,IDUM)
  253. melval=ipcheq
  254. C segsup melval
  255. IF (IERR.NE.0) GOTO 10
  256. MCHPOI=IPCH1
  257. DO i=1,IPCHP(/1)
  258. MSOUPO=IPCHP(i)
  259. segact msoupo*mod
  260. NOCOMP(1)=nomcq
  261. segact msoupo
  262. ENDDO
  263. C ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  264. IF (iSou.GT.1) THEN
  265.  
  266. CALL ADCHPO(IPCH1,IPCONV,IRET,1.D0,1.D0)
  267. CALL DTCHPO(IPCH1)
  268. CALL DTCHPO(IPCONV)
  269. C write(6,*) ' isou iret',isou,iret
  270. IF (IRET.EQ.0) GOTO 10
  271. IPCONV=IRET
  272. ELSE
  273. IPCONV=IPCH1
  274. ENDIF
  275.  
  276. CALL ACTOBJ('CHPOINT ',IPCONV,1)
  277.  
  278. iOK=1
  279. 10 SEGSUP,MCHAM2,MCHEL2
  280. 20 continue
  281. melval=ipsono
  282. segsup melval
  283. 30 continue
  284. IF (iOK.EQ.0) GOTO 40
  285. ENDDO
  286. iOK=1
  287. 40 CONTINUE
  288. IF (iOK.EQ.0) GOTO 100
  289. C ENDDO
  290.  
  291. C LES SUPPORTS GEOMETRIQUES DU CHPOINT ET DE L'OBJET MODELE
  292. C SONT INCOMPATIBLES
  293. C IF (IRRT.EQ.NSOUS) THEN
  294. C MOTERR(1:8)='MODELE '
  295. C MOTERR(9:16)='CHPOINT '
  296. C CALL ERREUR(135)
  297. C RETURN
  298. C ENDIF
  299. 100 CONTINUE
  300. C 100 CALL DTCHPO(IPCHCA)
  301.  
  302. END
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  

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