Télécharger fdebit.eso

Retour à la liste

Numérotation des lignes :

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

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