Télécharger flumas.eso

Retour à la liste

Numérotation des lignes :

  1. C FLUMAS SOURCE CB215821 19/07/30 21:16:20 10273
  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. NSOU=KMODEL(/1)
  64. C= Activation de MLMOTX si defini
  65. NINC = 0
  66. IF (MLMOTX.NE.0) THEN
  67. MLMOTS=MLMOTX
  68. SEGACT,MLMOTS
  69. NINC = MOTS(/2)
  70. ENDIF
  71.  
  72. C BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE
  73. C =============================================
  74. idimp1=IDIM+1
  75. IRRT=0
  76.  
  77. DO ISOU=1,NSOU
  78.  
  79. IPCHEL=0
  80. IMODEL=KMODEL(ISOU)
  81. NEF=NEFMOD
  82.  
  83. * Determination de l'ENVELOPPE du MASSIF
  84. ITGEOM=IMAMOD
  85. CALL ECROBJ('MAILLAGE',ITGEOM)
  86. IF (IDIM.EQ.3) THEN
  87. CALL ENVELO
  88. ELSE IF (IDIM.EQ.2) THEN
  89. CALL PRCONT
  90. ELSE IF (IDIM.EQ.1) THEN
  91. CALL PREX1D
  92. ENDIF
  93. CALL LIROBJ('MAILLAGE',IPENVE,1,IRET)
  94. CALL ACTOBJ('MAILLAGE',IPENVE,1)
  95. IF (IERR.NE.0) GOTO 9900
  96.  
  97. * ON RECUPERE LES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  98. * APPUYES STRICTEMENT SUR LE CHPOINT DE FLUX
  99. CALL ECROBJ('MAILLAGE',IPGEOM)
  100. CALL ECRCHA('STRI')
  101. CALL ECRCHA('APPU')
  102. CALL ECROBJ('MAILLAGE',IPENVE)
  103. CALL EXTREL(IRR,0,i)
  104.  
  105. * Pas DE MAILLAGE COMMUN A CETTE PARTIE DE L'ENVELOPPE ET DU CHPOINT
  106. IF (IRR.EQ.1) THEN
  107. IRRT=IRRT+1
  108. GOTO 9900
  109. ENDIF
  110.  
  111. * IL Y A DES MAILLAGES COMMUNS AU CHPOINT ET A L'ENVELOPPE
  112. CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET)
  113. CALL ACTOBJ('MAILLAGE',IPOGEO,1)
  114. IF (IERR.NE.0) GOTO 9900
  115. * ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES
  116. IPT3=IPOGEO
  117. SEGACT,IPT3
  118. NSOU3=IPT3.LISOUS(/1)
  119. IF (NSOU3.EQ.0) NBN2=IPT3.NUM(/1)
  120.  
  121. * BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE
  122. DO IMAIL=1,MAX(1,NSOU3)
  123. IF (NSOU3.NE.0) THEN
  124. IPT2=IPT3.LISOUS(IMAIL)
  125. SEGACT,IPT2
  126. IPOGEO=IPT2
  127. NBN2=IPT2.NUM(/1)
  128. ENDIF
  129. * RECHERCHE DE LA FORMULATION DES (SUR)FACES POUR LES MASSIF
  130. CALL FLUX3(NEF,NBN2,NEFACE)
  131. * IMPOSSIBLE D'UTILISER L'OPERATEUR FLUX POUR LES ELEMENTS DE TYPE NEF
  132. IF (NEFACE.EQ.0) THEN
  133. MOTERR(1:4)=NOMTP(NEF)
  134. CALL ERREUR(407)
  135. GOTO 9901
  136. ENDIF
  137. * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION
  138. CALL TSHAPE(NEFACE,'GAUSS',IPINTE)
  139. * ECHEC DANS L'ACQUISITION DES CARACTERISTIQUES D'INTEGRATION
  140. IF (IERR.NE.0) GOTO 9901
  141.  
  142. * ON GENERE UN CHAMELEM ELEMENTAIRE DE FLUX
  143. * A PARTIR DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO
  144. * ET DU CHPOINT
  145. if (IPCHPO.gt.0) then
  146. CALL CHAME1(IPOGEO,0,IPCHPO,' ',ICHELF,6)
  147. else
  148. *ou ET DU MCHAML
  149. ICHE = -1*IPCHPO
  150. CALL REDUIC(ICHE,IPOGEO,ICHELF)
  151. endif
  152. MCHEL1=ICHELF
  153. IF (IERR.NE.0) GOTO 9901
  154. MCHAM1=MCHEL1.ICHAML(1)
  155. NBCOMP=MCHAM1.IELVAL(/1)
  156. IF (NBCOMP.EQ.1) THEN
  157. IPFLOD=MCHAM1.IELVAL(1)
  158. ELSE
  159. C POUR CHAQUE ELEMENT,
  160. C ON DETERMINE UN VECTEUR DIRIGE VERS L INTERIEUR DU MASSIF
  161. C A PARTIR D UN POINT DE LA FACE ET DU CENTRE DE GRAVITE DU MASSIF
  162. C ON COPIE LE CHAMP EN AJOUTANT UNE COMPOSANTE
  163. IF (MLMOTX.EQ.0) THEN
  164. MOTERR(1:8)='LISTMOTS'
  165. CALL ERREUR(37)
  166. GOTO 9901
  167. ENDIF
  168. MLMOTS=MLMOTX
  169. MELVAL=MCHAM1.IELVAL(1)
  170. N1PTEL=VELCHE(/1)
  171. N1EL=VELCHE(/2)
  172. N2PTEL=0
  173. N2EL=0
  174. NBCOMP=IDIM
  175. N2=NBCOMP+IDIM
  176. SEGINI,MCHAML
  177. IPFLOD=MCHAML
  178. DO I=1,N2
  179. SEGINI,MELVAL
  180. IELVAL(I)=MELVAL
  181. ENDDO
  182. DO I=1,NINC
  183. IMOT1=MOTS(i)
  184. DO J=1,NINC
  185. IMOT2=MCHAM1.NOMCHE(J)
  186. IF (IMOT1.EQ.IMOT2) IVAL(I)=J
  187. ENDDO
  188. ENDDO
  189. DO I=1,NBCOMP
  190. MELVA1=MCHAM1.IELVAL(IVAL(I))
  191. MELVAL=IELVAL(I)
  192. DO j=1,N1EL
  193. DO k=1,N1PTEL
  194. VELCHE(k,j)=MELVA1.VELCHE(k,j)
  195. ENDDO
  196. ENDDO
  197. ENDDO
  198.  
  199. NBPTE1=N1PTEL
  200. NEL1=N1EL
  201. NUMPOI=1
  202. MELEME=IPOGEO
  203. IPT1=ITGEOM
  204. NBMA1=NUM(/1)
  205. DO IEF=1,NUM(/2)
  206. DO IEM=1,IPT1.NUM(/2)
  207. JNE=0
  208. DO INM=1,IPT1.NUM(/1)
  209. DO INF=1,NBMA1
  210. IF (IPT1.NUM(INM,IEM).EQ.NUM(INF,IEF)) JNE=JNE+1
  211. ENDDO
  212. ENDDO
  213. IF (JNE.EQ.NBMA1) GOTO 170
  214. ENDDO
  215. DO j=1,N2
  216. MELVAL=IELVAL(j)
  217. SEGSUP,MELVAL
  218. ENDDO
  219.  
  220. CALL ERREUR(21)
  221. GOTO 9901
  222. C CDG element de "volume"
  223. C CDG de la "face"
  224. C Calcul de la normale interieure (stocker dans MCHAML)
  225. 170 NBM=IPT1.NUM(/1)
  226. IF (IDIM.EQ.2) THEN
  227. XG=XZero
  228. YG=XZero
  229. DO INM=1,NBM
  230. IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  231. XG=XG+XCOOR(IREFM+1)
  232. YG=YG+XCOOR(IREFM+2)
  233. ENDDO
  234. XG=XG/NBM
  235. YG=YG/NBM
  236. XK=XZero
  237. YK=XZero
  238. DO INF=1,NBMA1
  239. IREFF=(NUM(INF,IEF)-1)*idimp1
  240. XK=XK+XCOOR(IREFF+1)
  241. YK=YK+XCOOR(IREFF+2)
  242. ENDDO
  243. XK=XK/NBMA1
  244. YK=YK/NBMA1
  245. V1=XG-XK
  246. V2=YG-YK
  247. VN=SQRT(V1*V1+V2*V2)
  248. V1=V1/VN
  249. V2=V2/VN
  250. DO INF=1,NBMA1
  251. MELVAL=IELVAL(NBCOMP+1)
  252. VELCHE(INF,IEF)=V1
  253. MELVAL=IELVAL(NBCOMP+2)
  254. VELCHE(INF,IEF)=V2
  255. ENDDO
  256. ELSE IF (IDIM.EQ.3) THEN
  257. XG=XZero
  258. YG=XZero
  259. ZG=XZero
  260. DO INM=1,NBM
  261. IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  262. XG=XG+XCOOR(IREFM+1)
  263. YG=YG+XCOOR(IREFM+2)
  264. ZG=ZG+XCOOR(IREFM+3)
  265. ENDDO
  266. XG=XG/NBM
  267. YG=YG/NBM
  268. ZG=ZG/NBM
  269. XK=XZero
  270. YK=XZero
  271. ZK=XZero
  272. DO INF=1,NBMA1
  273. IREFF=(NUM(INF,IEF)-1)*idimp1
  274. XK=XK+XCOOR(IREFF+1)
  275. YK=YK+XCOOR(IREFF+2)
  276. ZK=ZK+XCOOR(IREFF+3)
  277. ENDDO
  278. XK=XK/NBMA1
  279. YK=YK/NBMA1
  280. ZK=ZK/NBMA1
  281. V1=XG-XK
  282. V2=YG-YK
  283. V3=ZG-ZK
  284. VN=SQRT(V1*V1+V2*V2+V3*V3)
  285. V1=V1/VN
  286. V2=V2/VN
  287. V3=V3/VN
  288. DO INF=1,NBMA1
  289. MELVAL=IELVAL(NBCOMP+1)
  290. VELCHE(INF,IEF)=V1
  291. MELVAL=IELVAL(NBCOMP+2)
  292. VELCHE(INF,IEF)=V2
  293. MELVAL=IELVAL(NBCOMP+3)
  294. VELCHE(INF,IEF)=V3
  295. ENDDO
  296. ELSE IF (IDIM.EQ.1) THEN
  297. XG=XZero
  298. DO INM=1,NBM
  299. IREFM=(IPT1.NUM(INM,IEM)-1)*idimp1
  300. XG=XG+XCOOR(IREFM+1)
  301. ENDDO
  302. XG=XG/NBM
  303. XK=XZero
  304. DO INF=1,NBMA1
  305. IREFF=(NUM(INF,IEF)-1)*idimp1
  306. XK=XK+XCOOR(IREFF+1)
  307. ENDDO
  308. XK=XK/NBMA1
  309. V1=XG-XK
  310. V1=V1/ABS(V1)
  311. DO INF=1,NBMA1
  312. MELVAL=IELVAL(NBCOMP+1)
  313. VELCHE(INF,IEF)=V1
  314. ENDDO
  315. ENDIF
  316. ENDDO
  317. ENDIF
  318. * CHAMELEM ELEMENTAIRE DES FLUX NODAUX EQUIVALENTS
  319. L1=7
  320. N1=1
  321. N3=1
  322. SEGINI,MCHELM
  323. IPCHEL=MCHELM
  324. TITCHE='CHALEUR'
  325. IFOCHE=IFOUR
  326. INFCHE(1,1)=0
  327. IMACHE(1)=IPOGEO
  328. N2=1
  329. SEGINI,MCHAML
  330. ICHAML(1)=MCHAML
  331. NOMCHE(1)='FLUX'
  332. TYPCHE(1)='REAL*8'
  333. * CALCUL DES FLUX NODAUX EQUIVALENTS
  334. * FACES ASSOCIEES SEG2 OU SEG3
  335. IF (NEFACE.EQ.2.OR.NEFACE.EQ.3) THEN
  336. CALL FLUMA2(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  337. * FACES ASSOCIEES TRI3,TRI6,QUA4 OU QUA8
  338. ELSE IF (NEFACE.EQ. 4.OR.NEFACE.EQ.6.OR.NEFACE.EQ.8.OR.
  339. . NEFACE.EQ.10) THEN
  340. CALL FLUMA3(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  341. * FACES ASSOCIEES POI1
  342. ELSE IF (NEFACE.EQ.45) THEN
  343. CALL FLUMA1(IPFLOD,IPOGEO,IPINTE,NUMPOI,IPFLEQ)
  344. ENDIF
  345. IF (NUMPOI.EQ.1) THEN
  346. MCHAM2=IPFLOD
  347. DO i=1,MCHAM2.IELVAL(/1)
  348. MELVAL=MCHAM2.IELVAL(i)
  349. SEGSUP,MELVAL
  350. ENDDO
  351. SEGSUP,MCHAM2
  352. ENDIF
  353. IF (IERR.NE.0) THEN
  354. SEGSUP,MCHAML,MCHELM
  355. GOTO 9901
  356. ENDIF
  357. IELVAL(1)=IPFLEQ
  358.  
  359. * ON TRANSFORME LE CHAMELEM EN CHPOINT
  360. CALL CHAMPO(IPCHEL,0,IPCH1,IDUM)
  361. MCHPOI=IPCH1
  362. DO i=1,IPCHP(/1)
  363. MSOUPO=IPCHP(i)
  364. NOCOMP(1)=nomcq
  365. ENDDO
  366.  
  367. CALL DTCHEL(IPCHEL)
  368. * ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
  369. IF ((ISOU-IRRT).GT.1.OR.IMAIL.GT.1) THEN
  370. CALL ADCHPO(IPCH1,IPFLUX,IRET,XUn,XUn)
  371. IF (IRET.EQ.0) GOTO 9901
  372. C* CALL ECRCHA('GEOM')
  373. CALL DTCHPO(IPCH1)
  374. C* CALL ECRCHA('GEOM')
  375. CALL DTCHPO(IPFLUX)
  376. IPFLUX=IRET
  377. ELSE
  378. IPFLUX=IPCH1
  379. ENDIF
  380. ENDDO
  381. 9901 CONTINUE
  382. 9900 CONTINUE
  383. IF (IERR.NE.0) GOTO 9999
  384. ENDDO
  385.  
  386. * IL N'EXISTE PAS D'ELEMENTS COMMUNS AU CHPOINT DES FLUX NODAUX
  387. * ET A L'ENVELOPPE DU MASSIF
  388. IF (IRRT.EQ.NSOU) CALL ERREUR(408)
  389.  
  390. 9999 CONTINUE
  391.  
  392. END
  393.  
  394.  
  395.  

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