Télécharger flumas.eso

Retour à la liste

Numérotation des lignes :

  1. C FLUMAS SOURCE BP208322 15/06/22 21:18:17 8543
  2.  
  3. C=======================================================================
  4. C= F L U M A S =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul des flux nodaux equivalents a une condition de FLUX IMPOSE =
  10. C= pour des elements de type MASSIF (1D, 2D, 3D) =
  11. C= Sous-programme appele par FLUX2 (flux2.eso) =
  12. C= =
  13. C= Parametres : (E)=Entree (S)=Sortie =
  14. C= ------------ =
  15. C= IPMODE (E) Pointeur sur le segment MMODEL =
  16. C= IPGEOM (E) Objet MAILLAGE support de IPCHPO =
  17. C= IPCHPO (E) Pointeur sur le CHPOINT (ou le MCHAML) de flux =
  18. C= imposes aux noeuds de la structure =
  19. C= (champ variable ou constant) =
  20. C= NUMPOI (E) Vaut -1 si le flux impose est normal a la surface, =
  21. C= sinon pointeur sur un POINT correspondant a la =
  22. C= direction du flux (par rapport au repere global) =
  23. C= MOCOMP (E) Nom de la composante du champ de flux equivalents =
  24. C= MLMOTX (E) Pointeur MLMOTS de la liste des composantes de =
  25. C= IPCHPO associees aux 3 directions x,y,z. =
  26. C= IPFLUX (S) Pointeur sur le champ des flux nodaux equivalents =
  27. C= =
  28. C= Variables locales : =
  29. C= ------------------- =
  30. C= ITGEOM Pointeur sur un MAILLAGE elementaire du MASSIF =
  31. C= IPENVE Pointeur sur l'enveloppe d'un maillage MASSIF =
  32. C= IPGEOM Pointeur sur un MAILLAGE elementaire du CHPOINT =
  33. C= IPOGEO Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF =
  34. C= =
  35. C= Denis ROBERT, le 1er fevrier 1988. =
  36. C=======================================================================
  37.  
  38. SUBROUTINE FLUMAS (IPMODE,IPGEOM,IPCHPO,NUMPOI,NOMCQ,MLMOTX,
  39. & IPFLUX)
  40.  
  41. IMPLICIT INTEGER(I-N)
  42. IMPLICIT REAL*8 (A-H,O-Z)
  43.  
  44. -INC CCOPTIO
  45. -INC CCHAMP
  46. -INC CCREEL
  47. -INC SMCHAML
  48. -INC SMCHPOI
  49. -INC SMMODEL
  50. -INC SMELEME
  51. -INC SMCOORD
  52. -INC SMLMOTS
  53.  
  54. CHARACTER*(*) NOMCQ
  55.  
  56. PARAMETER (XUn=1.)
  57.  
  58. DIMENSION IVAL(4)
  59. CHARACTER*4 IMOT1,IMOT2
  60.  
  61. C= Activation du MMODEL
  62. MMODEL=IPMODE
  63. SEGACT,MMODEL
  64. NSOU=KMODEL(/1)
  65. C= Activation de MLMOTX si defini
  66. NINC = 0
  67. IF (MLMOTX.NE.0) THEN
  68. MLMOTS=MLMOTX
  69. SEGACT,MLMOTS
  70. NINC = MOTS(/2)
  71. ENDIF
  72.  
  73. C BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE
  74. C =============================================
  75. idimp1=IDIM+1
  76. IRRT=0
  77.  
  78. DO ISOU=1,NSOU
  79.  
  80. IPCHEL=0
  81.  
  82. IMODEL=KMODEL(ISOU)
  83. SEGACT,IMODEL
  84. NEF=NEFMOD
  85.  
  86. * Determination de l'ENVELOPPE du MASSIF
  87. ITGEOM=IMAMOD
  88. CALL ECROBJ('MAILLAGE',ITGEOM)
  89. IF (IDIM.EQ.3) THEN
  90. CALL ENVELO
  91. ELSE IF (IDIM.EQ.2) THEN
  92. CALL PRCONT
  93. ELSE IF (IDIM.EQ.1) THEN
  94. CALL PREX1D
  95. ENDIF
  96. CALL LIROBJ('MAILLAGE',IPENVE,1,IRET)
  97. IF (IERR.NE.0) GOTO 9900
  98.  
  99. * ON RECUPERE LES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  100. * APPUYES STRICTEMENT SUR LE CHPOINT DE FLUX
  101. CALL ECROBJ('MAILLAGE',IPGEOM)
  102. CALL ECRCHA('STRI')
  103. CALL ECRCHA('APPU')
  104. CALL ECROBJ('MAILLAGE',IPENVE)
  105. CALL EXTREL(IRR,0,i)
  106.  
  107. * Pas DE MAILLAGE COMMUN A CETTE PARTIE DE L'ENVELOPPE ET DU CHPOINT
  108. IF (IRR.EQ.1) THEN
  109. IRRT=IRRT+1
  110. GOTO 9900
  111. ENDIF
  112.  
  113. * IL Y A DES MAILLAGES COMMUNS AU CHPOINT ET A L'ENVELOPPE
  114. CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET)
  115. IF (IERR.NE.0) GOTO 9900
  116. * ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES
  117. IPT3=IPOGEO
  118. SEGACT,IPT3
  119. NSOU3=IPT3.LISOUS(/1)
  120. IF (NSOU3.EQ.0) NBN2=IPT3.NUM(/1)
  121.  
  122. * BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE
  123. DO IMAIL=1,MAX(1,NSOU3)
  124. IF (NSOU3.NE.0) THEN
  125. IPT2=IPT3.LISOUS(IMAIL)
  126. SEGACT,IPT2
  127. IPOGEO=IPT2
  128. NBN2=IPT2.NUM(/1)
  129. SEGDES,IPT2
  130. ENDIF
  131. * RECHERCHE DE LA FORMULATION DES (SUR)FACES POUR LES MASSIF
  132. CALL FLUX3(NEF,NBN2,NEFACE)
  133. * IMPOSSIBLE D'UTILISER L'OPERATEUR FLUX POUR LES ELEMENTS DE TYPE NEF
  134. IF (NEFACE.EQ.0) THEN
  135. MOTERR(1:4)=NOMTP(NEF)
  136. CALL ERREUR(407)
  137. GOTO 9901
  138. ENDIF
  139. * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION
  140. CALL TSHAPE(NEFACE,'GAUSS',IPINTE)
  141. * ECHEC DANS L'ACQUISITION DES CARACTERISTIQUES D'INTEGRATION
  142. IF (IERR.NE.0) GOTO 9901
  143.  
  144. * ON GENERE UN CHAMELEM ELEMENTAIRE DE FLUX
  145. * A PARTIR DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO
  146. * ET DU CHPOINT
  147. if (IPCHPO.gt.0) then
  148. CALL CHAME1(IPOGEO,0,IPCHPO,' ',ICHELF,6)
  149. else
  150. *ou ET DU MCHAML
  151. ICHE = -1*IPCHPO
  152. CALL REDUIC(ICHE,IPOGEO,ICHELF)
  153. endif
  154. MCHEL1=ICHELF
  155. IF (IERR.NE.0) GOTO 9901
  156. SEGACT,MCHEL1
  157. MCHAM1=MCHEL1.ICHAML(1)
  158. SEGDES,MCHEL1
  159. SEGACT,MCHAM1
  160. NBCOMP=MCHAM1.IELVAL(/1)
  161. IF (NBCOMP.EQ.1) THEN
  162. IPFLOD=MCHAM1.IELVAL(1)
  163. SEGDES,MCHAM1
  164. ELSE
  165. C POUR CHAQUE ELEMENT,
  166. C ON DETERMINE UN VECTEUR DIRIGE VERS L INTERIEUR DU MASSIF
  167. C A PARTIR D UN POINT DE LA FACE ET DU CENTRE DE GRAVITE DU MASSIF
  168. C ON COPIE LE CHAMP EN AJOUTANT UNE COMPOSANTE
  169. IF (MLMOTX.EQ.0) THEN
  170. MOTERR(1:8)='LISTMOTS'
  171. CALL ERREUR(37)
  172. GOTO 9901
  173. ENDIF
  174. MLMOTS=MLMOTX
  175. MELVAL=MCHAM1.IELVAL(1)
  176. SEGACT,MELVAL
  177. N1PTEL=VELCHE(/1)
  178. N1EL=VELCHE(/2)
  179. SEGDES,MELVAL
  180. N2PTEL=0
  181. N2EL=0
  182. NBCOMP=IDIM
  183. N2=NBCOMP+IDIM
  184. SEGINI,MCHAML
  185. IPFLOD=MCHAML
  186. DO I=1,N2
  187. SEGINI,MELVAL
  188. IELVAL(I)=MELVAL
  189. SEGDES,MELVAL
  190. ENDDO
  191. DO I=1,NINC
  192. IMOT1=MOTS(i)
  193. DO J=1,NINC
  194. IMOT2=MCHAM1.NOMCHE(J)
  195. IF (IMOT1.EQ.IMOT2) IVAL(I)=J
  196. ENDDO
  197. ENDDO
  198. DO I=1,NBCOMP
  199. MELVA1=MCHAM1.IELVAL(IVAL(I))
  200. MELVAL=IELVAL(I)
  201. SEGACT,MELVAL*MOD,MELVA1
  202. DO j=1,N1EL
  203. DO k=1,N1PTEL
  204. VELCHE(k,j)=MELVA1.VELCHE(k,j)
  205. ENDDO
  206. ENDDO
  207. SEGDES,MELVA1
  208. ENDDO
  209. C activation des composantes supplementaires
  210. DO i=NBCOMP+1,N2
  211. MELVAL=IELVAL(i)
  212. SEGACT,MELVAL*MOD
  213. ENDDO
  214. NBPTE1=N1PTEL
  215. NEL1=N1EL
  216. SEGDES,MCHAM1
  217. NUMPOI=1
  218. MELEME=IPOGEO
  219. IPT1=ITGEOM
  220. SEGACT,MELEME,IPT1
  221. NBMA1=NUM(/1)
  222. DO IEF=1,NUM(/2)
  223. DO IEM=1,IPT1.NUM(/2)
  224. JNE=0
  225. DO INM=1,IPT1.NUM(/1)
  226. DO INF=1,NBMA1
  227. IF (IPT1.NUM(INM,IEM).EQ.NUM(INF,IEF)) JNE=JNE+1
  228. ENDDO
  229. ENDDO
  230. IF (JNE.EQ.NBMA1) GOTO 170
  231. ENDDO
  232. SEGDES,IPT1,MELEME
  233. DO j=1,N2
  234. MELVAL=IELVAL(j)
  235. SEGSUP,MELVAL
  236. ENDDO
  237. SEGDES,MCHAML
  238. *? Achtung SEGSUP,IPT3
  239. *? Erreur a voir
  240. CALL ERREUR(21)
  241. GOTO 9901
  242. C CDG element de "volume"
  243. C CDG de la "face"
  244. C Calcul de la normale interieure (stocker dans MCHAML)
  245. 170 NBM=IPT1.NUM(/1)
  246. IF (IDIM.EQ.2) THEN
  247. XG=XZero
  248. YG=XZero
  249. DO INM=1,NBM
  250. IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  251. XG=XG+XCOOR(IREFM+1)
  252. YG=YG+XCOOR(IREFM+2)
  253. ENDDO
  254. XG=XG/NBM
  255. YG=YG/NBM
  256. XK=XZero
  257. YK=XZero
  258. DO INF=1,NBMA1
  259. IREFF=(NUM(INF,IEF)-1)*idimp1
  260. XK=XK+XCOOR(IREFF+1)
  261. YK=YK+XCOOR(IREFF+2)
  262. ENDDO
  263. XK=XK/NBMA1
  264. YK=YK/NBMA1
  265. V1=XG-XK
  266. V2=YG-YK
  267. VN=SQRT(V1*V1+V2*V2)
  268. V1=V1/VN
  269. V2=V2/VN
  270. DO INF=1,NBMA1
  271. MELVAL=IELVAL(NBCOMP+1)
  272. VELCHE(INF,IEF)=V1
  273. MELVAL=IELVAL(NBCOMP+2)
  274. VELCHE(INF,IEF)=V2
  275. ENDDO
  276. ELSE IF (IDIM.EQ.3) THEN
  277. XG=XZero
  278. YG=XZero
  279. ZG=XZero
  280. DO INM=1,NBM
  281. IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  282. XG=XG+XCOOR(IREFM+1)
  283. YG=YG+XCOOR(IREFM+2)
  284. ZG=ZG+XCOOR(IREFM+3)
  285. ENDDO
  286. XG=XG/NBM
  287. YG=YG/NBM
  288. ZG=ZG/NBM
  289. XK=XZero
  290. YK=XZero
  291. ZK=XZero
  292. DO INF=1,NBMA1
  293. IREFF=(NUM(INF,IEF)-1)*idimp1
  294. XK=XK+XCOOR(IREFF+1)
  295. YK=YK+XCOOR(IREFF+2)
  296. ZK=ZK+XCOOR(IREFF+3)
  297. ENDDO
  298. XK=XK/NBMA1
  299. YK=YK/NBMA1
  300. ZK=ZK/NBMA1
  301. V1=XG-XK
  302. V2=YG-YK
  303. V3=ZG-ZK
  304. VN=SQRT(V1*V1+V2*V2+V3*V3)
  305. V1=V1/VN
  306. V2=V2/VN
  307. V3=V3/VN
  308. DO INF=1,NBMA1
  309. MELVAL=IELVAL(NBCOMP+1)
  310. VELCHE(INF,IEF)=V1
  311. MELVAL=IELVAL(NBCOMP+2)
  312. VELCHE(INF,IEF)=V2
  313. MELVAL=IELVAL(NBCOMP+3)
  314. VELCHE(INF,IEF)=V3
  315. ENDDO
  316. ELSE IF (IDIM.EQ.1) THEN
  317. XG=XZero
  318. DO INM=1,NBM
  319. IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  320. XG=XG+XCOOR(IREFM+1)
  321. ENDDO
  322. XG=XG/NBM
  323. XK=XZero
  324. DO INF=1,NBMA1
  325. IREFF=(NUM(INF,IEF)-1)*idimp1
  326. XK=XK+XCOOR(IREFF+1)
  327. ENDDO
  328. XK=XK/NBMA1
  329. V1=XG-XK
  330. V1=V1/ABS(V1)
  331. DO INF=1,NBMA1
  332. MELVAL=IELVAL(NBCOMP+1)
  333. VELCHE(INF,IEF)=V1
  334. ENDDO
  335. ENDIF
  336. ENDDO
  337. DO j=1,IDIM
  338. MELVAL=IELVAL(NBCOMP+j)
  339. SEGDES,MELVAL
  340. ENDDO
  341. SEGDES,MCHAML
  342. SEGDES,IPT1,MELEME
  343. ENDIF
  344. * CHAMELEM ELEMENTAIRE DES FLUX NODAUX EQUIVALENTS
  345. L1=7
  346. N1=1
  347. N3=1
  348. SEGINI,MCHELM
  349. IPCHEL=MCHELM
  350. TITCHE='CHALEUR'
  351. IFOCHE=IFOUR
  352. INFCHE(1,1)=0
  353. IMACHE(1)=IPOGEO
  354. N2=1
  355. SEGINI,MCHAML
  356. ICHAML(1)=MCHAML
  357. NOMCHE(1)='FLUX'
  358. TYPCHE(1)='REAL*8'
  359. * CALCUL DES FLUX NODAUX EQUIVALENTS
  360. * FACES ASSOCIEES SEG2 OU SEG3
  361. IF (NEFACE.EQ.2.OR.NEFACE.EQ.3) THEN
  362. CALL FLUMA2(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  363. * FACES ASSOCIEES TRI3,TRI6,QUA4 OU QUA8
  364. ELSE IF (NEFACE.EQ. 4.OR.NEFACE.EQ.6.OR.NEFACE.EQ.8.OR.
  365. . NEFACE.EQ.10) THEN
  366. CALL FLUMA3(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  367. * FACES ASSOCIEES POI1
  368. ELSE IF (NEFACE.EQ.45) THEN
  369. CALL FLUMA1(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  370. ENDIF
  371. IF (NUMPOI.EQ.1) THEN
  372. MCHAM2=IPFLOD
  373. SEGACT,MCHAM2
  374. DO i=1,MCHAM2.IELVAL(/1)
  375. MELVAL=MCHAM2.IELVAL(i)
  376. SEGSUP,MELVAL
  377. ENDDO
  378. SEGSUP,MCHAM2
  379. ENDIF
  380. IF (IERR.NE.0) THEN
  381. SEGSUP,MCHAML,MCHELM
  382. GOTO 9901
  383. ENDIF
  384. IELVAL(1)=IPFLEQ
  385. SEGDES,MCHAML,MCHELM
  386. * ON TRANSFORME LE CHAMELEM EN CHPOINT
  387. CALL CHAMPO(IPCHEL,0,IPCH1,IDUM)
  388. MCHPOI=IPCH1
  389. SEGACT,MCHPOI
  390. DO i=1,IPCHP(/1)
  391. MSOUPO=IPCHP(i)
  392. SEGACT,MSOUPO*MOD
  393. NOCOMP(1)=nomcq
  394. SEGDES,MSOUPO
  395. ENDDO
  396. SEGDES,MCHPOI
  397. CALL DTCHEL(IPCHEL)
  398. * ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  399. IF ((ISOU-IRRT).GT.1.OR.IMAIL.GT.1) THEN
  400. CALL ADCHPO(IPCH1,IPFLUX,IRET,XUn,XUn)
  401. IF (IRET.EQ.0) GOTO 9901
  402. C* CALL ECRCHA('GEOM')
  403. CALL DTCHPO(IPCH1)
  404. C* CALL ECRCHA('GEOM')
  405. CALL DTCHPO(IPFLUX)
  406. IPFLUX=IRET
  407. ELSE
  408. IPFLUX=IPCH1
  409. ENDIF
  410. ENDDO
  411. 9901 CONTINUE
  412. SEGDES,IPT3
  413. 9900 CONTINUE
  414. SEGDES,IMODEL
  415. IF (IERR.NE.0) GOTO 9999
  416. ENDDO
  417.  
  418. * IL N'EXISTE PAS D'ELEMENTS COMMUNS AU CHPOINT DES FLUX NODAUX
  419. * ET A L'ENVELOPPE DU MASSIF
  420. IF (IRRT.EQ.NSOU) CALL ERREUR(408)
  421.  
  422. 9999 CONTINUE
  423. SEGDES,MMODEL
  424. IF (MLMOTX.NE.0) THEN
  425. MLMOTS = MLMOTX
  426. SEGDES,MLMOTS
  427. ENDIF
  428.  
  429. RETURN
  430. END
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  

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