Télécharger flucoq.eso

Retour à la liste

Numérotation des lignes :

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

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