Télécharger fptuya.eso

Retour à la liste

Numérotation des lignes :

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

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