Télécharger fptuya.eso

Retour à la liste

Numérotation des lignes :

  1. C FPTUYA SOURCE MB234859 16/12/14 21:15:10 9253
  2. SUBROUTINE FPTUYA(IPMODL,IPCHE1,IPTFP,IRET)
  3. C____________________________________________________________________
  4. C
  5. C CALCULE LES FORCES DE PRESSIONS APPLIQUEES SUR DES TUYAUX
  6. C ( EFFET DE FOND ) APPELE PAR PRESSI
  7. C
  8. C
  9. C ENTREES :
  10. C ---------
  11. C
  12. C IPCHE1 POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  13. C IPMODL POINTEUR SUR UN MMODEL
  14. C
  15. C SORTIES
  16. C
  17. C
  18. C IPTFP CHPOINT DES FORCES NODALES EQUIVALENTES
  19. C IRET 1 OU 0 SI SUCCES OU NON
  20. C
  21. C M. PETIT NOVEMBRE 89
  22. C PASSAGE AUX NOUVEAU CHAMELEM PAR JM CAMPENON LE 04 09 90
  23. C
  24. C_____________________________________________________________________
  25. C
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28. C
  29. -INC CCOPTIO
  30. -INC CCREEL
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMMODEL
  34. -INC SMCHAML
  35. -INC SMINTE
  36. *
  37. SEGMENT NOTYPE
  38. CHARACTER*16 TYPE(NBTYPE)
  39. ENDSEGMENT
  40. C
  41. SEGMENT MPTVAL
  42. INTEGER IPOS(NS) ,NSOF(NS)
  43. INTEGER IVAL(NCOSOU)
  44. CHARACTER*16 TYVAL(NCOSOU)
  45. ENDSEGMENT
  46. C
  47. CHARACTER*8 CMATE
  48. CHARACTER*(NCONCH) CONM
  49. PARAMETER ( NINF=3 )
  50. INTEGER INFOS(NINF)
  51. LOGICAL lsupfo
  52. C
  53. IRET = 0
  54. C
  55. NHRM=NIFOUR
  56. C
  57. C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE
  58. C
  59. CALL QUESUP (IPMODL,IPCHE1,3,0,ISUP,IRETCA)
  60. IF (ISUP.GT.1) RETURN
  61. C
  62. C ACTIVATION DU MODELE
  63. C
  64. MMODEL=IPMODL
  65. SEGACT MMODEL
  66. NSOUS=KMODEL(/1)
  67. C
  68. C CREATION D UN MCHELM INTERMEDIAIRE
  69. C
  70. N1=NSOUS
  71. L1=5
  72. N3=5
  73. SEGINI MCHELM
  74. ICHAM=MCHELM
  75. TITCHE='FORCE'
  76. IFOCHE=IFOUR
  77. C
  78. C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  79. C
  80. DO 101 ISOUS=1,NSOUS
  81. C
  82. C ON RECUPERE L INFORMATION GENERALE
  83. C
  84. IMODEL=KMODEL(ISOUS)
  85. SEGACT IMODEL
  86. IPMAIL=IMAMOD
  87. CONM =CONMOD
  88. IMACHE(ISOUS)=IPMAIL
  89. CONCHE(ISOUS)=CONMOD
  90. C
  91. C TRAITEMENT DU MODELE
  92. C
  93. MELE=NEFMOD
  94. MELEME=IMAMOD
  95. C
  96. C INFORMATION SUR L'ELEMENT FINI
  97. C
  98. * CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
  99. * IF (IERR.NE.0) THEN
  100. * SEGDES IMODEL,MMODEL
  101. * SEGSUP MCHELM
  102. * RETURN
  103. * ENDIF
  104. * INFO=IPINF
  105. MFR =INFELE(13)
  106. IF (MFR.EQ.13) GOTO 102
  107. C
  108. SEGDES IMODEL,MMODEL
  109. * SEGSUP INFO
  110. SEGSUP MCHELM
  111. CALL ERREUR(16)
  112. RETURN
  113. C
  114. C ON A BIEN DES ELEMENTS TUYA
  115. C
  116. * 102 MINTE=INFELE(11)
  117. 102 MINTE=INFMOD(5)
  118. IPMINT=MINTE
  119. * SEGSUP INFO
  120. C
  121. C CREATION DU TABLEAU INFOS
  122. C
  123. CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  124. IF (IRTD.EQ.0) THEN
  125. SEGDES IMODEL,MMODEL
  126. SEGSUP MCHELM
  127. RETURN
  128. ENDIF
  129. C
  130. INFCHE(ISOUS,1)=0
  131. INFCHE(ISOUS,2)=0
  132. INFCHE(ISOUS,3)=NHRM
  133. INFCHE(ISOUS,4)=MINTE
  134. INFCHE(ISOUS,5)=0
  135. C
  136. C ACTIVATION DU MELEME
  137. C
  138. SEGACT MELEME
  139. NBNN =NUM(/1)
  140. NBELEM=NUM(/2)
  141. IPPORE=0
  142. IF(MFR.EQ.33) IPPORE=NBNN
  143. C
  144. C RECHERCHE DES NOMS DE COMPOSANTES
  145. C
  146. if(lnomid(2).ne.0) then
  147. nomid=lnomid(2)
  148. segact nomid
  149. moforc=nomid
  150. nfor=lesobl(/2)
  151. nfac=0
  152. lsupfo=.false.
  153. else
  154. lsupfo=.true.
  155. CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC)
  156. endif
  157. C
  158. C TAILLE DES MELVAL A ALLOUER
  159. C
  160. N1PTEL=2
  161. N1EL=NBELEM
  162. N2PTEL=0
  163. N2EL=0
  164. C
  165. C CREATION DU MCHAML DE LA SOUS ZONE
  166. C
  167. N2=NFOR
  168. SEGINI MCHAML
  169. ICHAML(ISOUS)=MCHAML
  170. NS=1
  171. NCOSOU=NFOR
  172. SEGINI MPTVAL
  173. IVAFOR=MPTVAL
  174. NOMID=MOFORC
  175. SEGACT NOMID
  176. DO 1 ICOMP=1,NFOR
  177. NOMCHE(ICOMP)=LESOBL(ICOMP)
  178. TYPCHE(ICOMP)='REAL*8'
  179. SEGINI MELVAL
  180. IELVAL(ICOMP)=MELVAL
  181. IVAL(ICOMP)=MELVAL
  182. 1 CONTINUE
  183. SEGDES NOMID
  184. C
  185. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  186. C
  187. NBROBL=0
  188. NBRFAC=0
  189. MOCARA=0
  190. NCARA=0
  191. NCARF=0
  192. NCARR=0
  193. C
  194. C CARACTERISTIQUES POUR LES TUYAUX
  195. C
  196. NBROBL=3
  197. NBRFAC=2
  198. SEGINI NOMID
  199. MOCARA=NOMID
  200. LESOBL(1)='EPAI'
  201. LESOBL(2)='RAYO'
  202. LESOBL(3)='PRES'
  203. LESFAC(1)='RACO'
  204. LESFAC(2)='VECT'
  205. *
  206. NBTYPE=5
  207. SEGINI NOTYPE
  208. MOTYPE=NOTYPE
  209. TYPE(1)='REAL*8'
  210. TYPE(2)='REAL*8'
  211. TYPE(3)='REAL*8'
  212. TYPE(4)='REAL*8'
  213. TYPE(5)='POINTEURPOINT '
  214. C
  215. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  216. SEGSUP NOTYPE
  217. IF (IERR.NE.0) GOTO 9990
  218. MPTVAL=IVACAR
  219. NCARA=NBROBL
  220. NCARF=NBRFAC
  221. NCARR=NCARA+NCARF
  222. C
  223. IF (ISUP.EQ.1) THEN
  224. MINTE=IPMINT
  225. SEGACT,MINTE
  226. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  227. SEGDES,MINTE
  228. IF(IERR.NE.0)THEN
  229. ISUP=0
  230. GOTO 9990
  231. ENDIF
  232. ENDIF
  233. SEGDES NOMID
  234. C
  235. C CALCUL DES FORCES DE PRESSION
  236. C
  237. CALL FPELTU(0,IVACAR,IPMAIL,ISOUS,IVAFOR)
  238. C
  239. SEGDES MELEME
  240. SEGDES IMODEL
  241. C
  242. NOMID=MOCARA
  243. IF (MOCARA.NE.0) SEGSUP NOMID
  244. IF (ISUP.EQ.1) THEN
  245. CALL DTMVAL(IVACAR,3)
  246. ELSE
  247. CALL DTMVAL(IVACAR,1)
  248. ENDIF
  249. C
  250. NOMID=MOFORC
  251. if(lsupfo)SEGSUP NOMID
  252. CALL DTMVAL(IVAFOR,1)
  253. C
  254. SEGDES MCHAML
  255. C
  256. 101 CONTINUE
  257. SEGDES MMODEL
  258. SEGDES MCHELM
  259. IRET = 1
  260. CALL CHAMPO(ICHAM,0,IPTFP,IRET)
  261. CALL DTCHAM(ICHAM)
  262. RETURN
  263. C
  264. 9990 CONTINUE
  265. IRET=0
  266. C
  267. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  268. C
  269. NOMID=MOCARA
  270. IF (MOCARA.NE.0) SEGSUP NOMID
  271. IF (ISUP.EQ.1) THEN
  272. CALL DTMVAL(IVACAR,3)
  273. ELSE
  274. CALL DTMVAL(IVACAR,1)
  275. ENDIF
  276. C
  277. NOMID=MOFORC
  278. if(lsupfo)SEGSUP NOMID
  279. CALL DTMVAL(IVAFOR,1)
  280. C
  281. SEGDES MELEME
  282. SEGDES IMODEL
  283. SEGDES MMODEL
  284. SEGSUP MCHELM
  285. C
  286. RETURN
  287. END
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  

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