Télécharger fdebit.eso

Retour à la liste

Numérotation des lignes :

  1. C FDEBIT SOURCE BP208322 16/11/18 21:17:03 9177
  2. SUBROUTINE FDEBIT(IPCHE1,IPMODL,IPTFP,MOT1,IRET)
  3. C______________________________________________________________________
  4. C
  5. C CALCULE LES FORCES DUES A UN DEBIT IMPOSE SUR UNE FRONTIERE DE
  6. C MASSIF ( INSPIRE DE FPMASS )
  7. C
  8. C ENTREES :
  9. C ---------
  10. C
  11. C IPCHE1 CHPOINT CONTENANT LES VALEURS DES DEBITS AUX NOEUDS
  12. C DE LA FACE D UN MASSIF
  13. C IPMODL OBJET MMODEL SUR LEQUEL S APPLIQUE LA CONDITION DE
  14. C DEBIT
  15. C MOT1 NOM A DONNER AU RESULTAT SI PAS ' '
  16. C
  17. C SORTIES :
  18. C ---------
  19. C
  20. C IPTFP CHPOINT DES FORCES NODALES EQUIVALENTES
  21. C IRET 1 OU 0 SUIVANT SUCCES OU NON
  22. C
  23. C Passage aux nouveaux CHAMELEM par JM CAMPENOB LE 06/91
  24. C
  25. C_______________________________________________________________________
  26. C
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29. C
  30. -INC CCOPTIO
  31. -INC CCGEOME
  32. -INC CCHAMP
  33. -INC SMCOORD
  34. -INC SMELEME
  35. -INC SMMODEL
  36. -INC SMCHAML
  37. -INC SMCHPOI
  38. -INC TMTRAV
  39. C
  40. logical ltelq
  41. SEGMENT INFO
  42. INTEGER INFELL(JG)
  43. ENDSEGMENT
  44. C
  45. C SEGMENTS DE TRAVAIL POUR CREER LE CHPOINT
  46. C
  47. SEGMENT ICPR(XCOOR(/1)/(IDIM+1))
  48. C
  49. C CONTENU DU SEGMENT MTRAV
  50. C
  51. C NNNOE NOMBRE DE NOEUDS
  52. C IGEO LA LISTE DE CES NOEUDS
  53. C NNIN NOMBRE D'INCONNUES
  54. C INCO LA LISTE DE CES INCONNUES
  55. C NHAR LE NUMERO D'HARMONIQUE CORRESPONDANT
  56. C IBIN INDIQUE POUR UN NOEUD SI UNE INCONNUE EXISTE (=1 OU 0)
  57. C BB LA VALEUR CORRESPONDANTE
  58. C
  59. CHARACTER*(4) MOAPPU,MOSTRI,MOGEOM,MOFP,MOT1
  60. DATA MOAPPU/'APPU'/,MOSTRI/'STRI'/
  61. DATA MOGEOM/'GEOM'/,MOFP/'FP '/
  62. C
  63. IRET =1
  64. IGEOM=0
  65. NHRM=NIFOUR
  66. C
  67. MCHPOI=IPCHE1
  68. SEGACT MCHPOI
  69. C
  70. C ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS DU CHPOP
  71. C
  72. DO 50 I=1,IPCHP(/1)
  73. MSOUPO=IPCHP(I)
  74. SEGACT MSOUPO
  75. IF (I.GT.1) THEN
  76. ltelq=.false.
  77. CALL FUSE(IGEOM,IGEOC,IRET,ltelq)
  78. IGEOM=IRET
  79. ELSE
  80. IGEOM=IGEOC
  81. ENDIF
  82. SEGDES MSOUPO
  83. 50 CONTINUE
  84. SEGDES MCHPOI
  85. IF (IERR.NE.0) RETURN
  86. C
  87. C ACTIVATION DU MODEL
  88. C
  89. MMODEL=IPMODL
  90. SEGACT MMODEL
  91. NSOUS=KMODEL(/1)
  92. IRRT=0
  93. DO 100 ISOUS=1,NSOUS
  94. C
  95. C ON RECUPERE L INFORMATION GENERALE
  96. C
  97. IMODEL=KMODEL(ISOUS)
  98. SEGACT IMODEL
  99. IPMAIL=IMAMOD
  100. C
  101. C TRAITEMENT DU MODEL
  102. C
  103. MELM=NEFMOD
  104. C
  105. C ON RECUPERE LES ELTS DE L ENVELOPPE DU MASSIF APPUYES
  106. C STRICTEMENT SUR LE CHPOINT DE DEBIT
  107. C
  108. CALL ECROBJ('MAILLAGE',IGEOM)
  109. CALL ECRCHA(MOSTRI)
  110. CALL ECRCHA(MOAPPU)
  111. CALL ECROBJ('MAILLAGE',IPMAIL)
  112. IF (IDIM.EQ.2) CALL PRCONT
  113. IF (IDIM.EQ.3) CALL ENVELO
  114. IF (IERR.NE.0) THEN
  115. IRET=0
  116. SEGDES MMODEL
  117. SEGDES IMODEL
  118. RETURN
  119. ENDIF
  120. CALL EXTREL (IRR,0,IBNOR)
  121. IF(IRR.EQ.1) THEN
  122. IRRT=IRRT+IRR
  123. GOTO 100
  124. ENDIF
  125. CALL LIROBJ('MAILLAGE',IPOGEO,1,IRETOU)
  126. IF (IERR.NE.0) THEN
  127. IRET=0
  128. SEGDES MMODEL,IMODEL
  129. RETURN
  130. ENDIF
  131. C
  132. C ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET
  133. C GEOMETRIQUE ELEMENTAIRE DE SURFACE
  134. C
  135. IPT3=IPOGEO
  136. SEGACT IPT3
  137. IPT2=IPT3
  138. IB=0
  139. C
  140. C BOUCLE SUR LES SOUS ZONES DE L ENVELOPPE
  141. C
  142. DO 110 IB=1,MAX(1,IPT3.LISOUS(/1))
  143. IF (IPT3.LISOUS(/1).NE.0) THEN
  144. IPT2=IPT3.LISOUS(IB)
  145. SEGACT IPT2
  146. IPOGEO=IPT2
  147. ENDIF
  148. NBNN=IPT2.NUM(/1)
  149. IF (IPT3.LISOUS(/1).EQ.0) GOTO 112
  150. SEGDES IPT2
  151. C
  152. 112 CONTINUE
  153. MELE=0
  154. C
  155. C MILIEUX POREUX :
  156. C ON RECUPERE L'ELEMENT QUADRATIQUE DE FACE
  157. C
  158. IF(MELM.EQ.79.OR.MELM.EQ.80.OR.MELM.EQ.108
  159. & .OR.MELM.EQ.173.OR.MELM.EQ.174.OR.MELM.EQ.178
  160. & .OR.MELM.EQ.179.OR.MELM.EQ.185.OR.MELM.EQ.188) THEN
  161. MELE=3
  162. IELI=2
  163. ELSE IF(MELM.EQ.81.OR.MELM.EQ.82.OR.MELM.EQ.83
  164. & .OR.MELM.EQ.109.OR.MELM.EQ.110.OR.MELM.EQ.175
  165. & .OR.MELM.EQ.176.OR.MELM.EQ.177.OR.MELM.EQ.180
  166. & .OR.MELM.EQ.181.OR.MELM.EQ.182.OR.MELM.EQ.186
  167. & .OR.MELM.EQ.187.OR.MELM.EQ.189.OR.MELM.EQ.190) THEN
  168. IF (NBNN.EQ.6) THEN
  169. MELE=33
  170. C IELI=3 BALD 96/02/23
  171. IELI=4
  172. ELSE
  173. MELE=34
  174. C IELI=4 BALD 96/02/23
  175. IELI=8
  176. ENDIF
  177. ENDIF
  178. C
  179. IF (MELE.EQ.0) THEN
  180. C
  181. C ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR DEBIT POUR
  182. C LES ELEMENTS DE FORMULATION MELM
  183. C
  184. MOTERR(1:4)=NOMTP(MELM)
  185. MOTERR(5:8)=' '
  186. CALL ERREUR(193)
  187. SEGDES MMODEL
  188. SEGDES IMODEL
  189. SEGDES IPT3
  190. IRET=0
  191. RETURN
  192. ENDIF
  193. C
  194. C ON CREE L OBJET MODEL ASSOCIE A LA SURFACE ELEMENTAIRE
  195. C
  196. N1=1
  197. SEGINI MMODE1
  198. IPMOD1=MMODE1
  199. NFOR=FORMOD(/2)
  200. NMAT=MATMOD(/2)
  201. MN3 =INFMOD(/1)
  202. NPARMO=0
  203. nobmod=0
  204. SEGINI IMODE1
  205. MMODE1.KMODEL(1)=IMODE1
  206. IMODE1.IMAMOD=IPOGEO
  207. IMODE1.NEFMOD=MELE
  208. DO 10 I=1,NFOR
  209. IMODE1.FORMOD(I)=FORMOD(I)
  210. 10 CONTINUE
  211. DO 11 I=1,NFOR
  212. IMODE1.MATMOD(I)=MATMOD(I)
  213. 11 CONTINUE
  214. SEGDES MMODE1
  215. lzero=0
  216. call inomid ( imode1,' ',iret,lzero,lzero,lzero,lzero)
  217. call prquoi(imode1)
  218. SEGDES IMODE1
  219. C
  220. C ON TRANSFORME LE CHPOINT DE PRESSION EN CHELEM ELEMENTAIRE
  221. C
  222. CALL CHAME1(0,IPMOD1,IPCHE1,' ',ICHELP,3)
  223. IF (IERR.NE.0) THEN
  224. IRET=0
  225. CALL DTMODL(IPMOD1)
  226. SEGDES IPT3
  227. RETURN
  228. ENDIF
  229. MCHEL1=ICHELP
  230. SEGACT MCHEL1
  231. MCHAM1=MCHEL1.ICHAML(1)
  232. SEGACT MCHAM1
  233. IPTVPR=MCHAM1.IELVAL(1)
  234. C
  235. C INFORMATION SUR L'ELEMENT FINI
  236. C
  237. if(infmod(/1).lt.5) then
  238. CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  239. IF (IERR.NE.0) THEN
  240. IRET=0
  241. SEGDES MMODEL
  242. SEGDES IMODEL
  243. SEGDES IPT3
  244. CALL DTCHAM(ICHELP)
  245. CALL DTMODL(IPMOD1)
  246. RETURN
  247. ENDIF
  248. INFO=IPINF
  249. MFR =INFELL(13)
  250. IELE =INFELL(14)
  251. IPTINT=INFELL(11)
  252. segsup info
  253. ELSE
  254. iptint=infmod(5)
  255. MFR =INFELE(13)
  256. IELE =INFELE(14)
  257. ENDIF
  258. C
  259. C INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES
  260. C
  261. N1=1
  262. L1=8
  263. N3=3
  264. SEGINI MCHELM
  265. TITCHE='SCALAIRE'
  266. IFOCHE=IFOUR
  267. IPCHEL=MCHELM
  268. C
  269. IMACHE(1)=IPOGEO
  270. INFCHE(1,1)=0
  271. INFCHE(1,2)=0
  272. INFCHE(1,3)=NHRM
  273. C
  274. C RECHERCHE DE LA TAILLE DES MELVALS
  275. C
  276. MELEME=IPOGEO
  277. SEGACT MELEME
  278. N1EL =NUM(/2)
  279. NBBB=NBNNE(IELI)
  280. N1PTEL=NBBB
  281. N2PTEL=0
  282. N2EL =0
  283. SEGDES MELEME
  284. C
  285. C CREATION DU MCHAML DE LA SOUS ZONE
  286. C
  287. N2=1
  288. SEGINI MCHAML
  289. ICHAML(1)=MCHAML
  290. NOMCHE(1)='SCAL'
  291. TYPCHE(1)='REAL*8'
  292. SEGINI MELVAL
  293. IELVAL(1)=MELVAL
  294. IVAFOR=MELVAL
  295. C
  296. C CALCUL DES FORCES NODALES EQUIVALENTES
  297. C DEBRANCHEMENT SUIVANT LE TYPE DES ELEMENTS
  298. C
  299. C CAS DES ELEMENTS MASSIFS BIDIMENSIONNELS
  300. C FACE ASSOCIEE SEG3
  301. C CAS DES ELEMENTS MASSIFS TRIDIMENSIONNELS
  302. C FACES ASSOCIEES FAC6,FAC8
  303. C
  304. IF (MELE.EQ.3.OR.MELE.EQ.33.OR.MELE.EQ.34) THEN
  305. CALL FDE23D(IPTVPR,IPOGEO,IPTINT,IVAFOR,IELI)
  306. ELSE
  307. C
  308. C ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE
  309. C
  310. MOTERR(1:4)=NOMTP(MELE)
  311. MOTERR(5:12)='FDEBIT'
  312. CALL ERREUR(86)
  313. SEGDES IPT3
  314. SEGDES MCHEL1
  315. SEGDES MCHAM1
  316. CALL DTMODL(IPMOD1)
  317. GOTO 9990
  318. ENDIF
  319. C
  320. MELVAL=IVAFOR
  321. C
  322. C ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN
  323. C ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES
  324. C
  325. SEGINI ICPR
  326. NNNOE=0
  327. MELEME = IPOGEO
  328. C
  329. C CREATION DU TABLEAU ICPR
  330. C
  331. SEGACT MELEME
  332. NBNN =NUM(/1)
  333. NBELEM=NUM(/2)
  334. C
  335. DO 511 IOP = 1,NBNN
  336. DO 511 JOP = 1,NBELEM
  337. IPT= NUM(IOP,JOP)
  338. IF(ICPR(IPT).EQ.0) THEN
  339. NNNOE=NNNOE+1
  340. ICPR(IPT)=NNNOE
  341. ENDIF
  342. 511 CONTINUE
  343. C
  344. NNIN=1
  345. SEGINI MTRAV
  346. IF(MOT1.EQ.' ') THEN
  347. INCO(1)=MOFP
  348. ELSE
  349. INCO(1)=MOT1
  350. ENDIF
  351. SEGACT MELVAL
  352. NBPTEL=VELCHE(/1)
  353. NEL =VELCHE(/2)
  354. C
  355. C BOUCLE SUR LES ELEMENTS ET LES NOEUDS
  356. C
  357. DO 420 IBB=1,NBELEM
  358. DO 420 IC=1,NBSOM(IELE)
  359. ICC=IBSOM(NSPOS(IELE)+IC-1)
  360. IPT=ICPR(NUM(ICC,IBB))
  361. BB(1,IPT)=VELCHE(IC,IBB)+BB(1,IPT)
  362. IBIN(1,IPT)=1
  363. IGEO(IPT)=NUM(ICC,IBB)
  364. 420 CONTINUE
  365. C
  366. SEGDES MELVAL,MELEME
  367. C
  368. C CREATION DU CHPOINT
  369. C
  370. CALL CRECHP(MTRAV,IPCHPO)
  371. SEGSUP MTRAV,ICPR
  372. C
  373. SEGDES MELVAL,MCHAML,MCHELM
  374. CALL DTCHAM(IPCHEL)
  375. CALL DTCHAM(ICHELP)
  376. C
  377. IF (IPCHPO.EQ.0) GOTO 9990
  378. C
  379. C ADDITION DES CHPOINTS ELEMENTAIRES
  380. C
  381. IF ((ISOUS-IRRT).GT.1.OR.IB.GT.1) THEN
  382. CALL ADCHPO(IPCHPO,IPTFP,IRET,1D0,1D0)
  383. CALL ECRCHA(MOGEOM)
  384. CALL DTCHPO(IPCHPO)
  385. CALL ECRCHA(MOGEOM)
  386. CALL DTCHPO(IPTFP)
  387. IF (IRET.EQ.0) GOTO 9990
  388. IPTFP=IRET
  389. ELSE
  390. IPTFP=IPCHPO
  391. ENDIF
  392. CALL DTMODL(IPMOD1)
  393. 110 CONTINUE
  394. SEGDES IPT3
  395. SEGDES IMODEL
  396. C
  397. 100 CONTINUE
  398. IF(IRRT.EQ.KMODEL(/1)) THEN
  399. CALL ERREUR(395)
  400. IRET=0
  401. ENDIF
  402. SEGDES MMODEL
  403. RETURN
  404. C
  405. 9990 CONTINUE
  406. IRET=0
  407. C
  408. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  409. C
  410. MELVAL=IVAFOR
  411. SEGSUP MELVAL
  412. SEGSUP MCHAML
  413. SEGSUP MCHELM
  414. C
  415. SEGDES IMODEL
  416. SEGDES MMODEL
  417. RETURN
  418. END
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  
  442.  

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