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. -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. * SEGSUP MCHELM
  101. * RETURN
  102. * ENDIF
  103. * INFO=IPINF
  104. MFR =INFELE(13)
  105. IF (MFR.EQ.13) GOTO 102
  106. C
  107. * SEGSUP INFO
  108. SEGSUP MCHELM
  109. CALL ERREUR(16)
  110. RETURN
  111. C
  112. C ON A BIEN DES ELEMENTS TUYA
  113. C
  114. * 102 MINTE=INFELE(11)
  115. 102 MINTE=INFMOD(5)
  116. IPMINT=MINTE
  117. * SEGSUP INFO
  118. C
  119. C CREATION DU TABLEAU INFOS
  120. C
  121. CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  122. IF (IRTD.EQ.0) THEN
  123. SEGSUP MCHELM
  124. RETURN
  125. ENDIF
  126. C
  127. INFCHE(ISOUS,1)=0
  128. INFCHE(ISOUS,2)=0
  129. INFCHE(ISOUS,3)=NHRM
  130. INFCHE(ISOUS,4)=MINTE
  131. INFCHE(ISOUS,5)=0
  132. C
  133. C ACTIVATION DU MELEME
  134. C
  135. SEGACT MELEME
  136. NBNN =NUM(/1)
  137. NBELEM=NUM(/2)
  138. IPPORE=0
  139. IF(MFR.EQ.33) IPPORE=NBNN
  140. C
  141. C RECHERCHE DES NOMS DE COMPOSANTES
  142. C
  143. if(lnomid(2).ne.0) then
  144. nomid=lnomid(2)
  145. segact nomid
  146. moforc=nomid
  147. nfor=lesobl(/2)
  148. nfac=0
  149. lsupfo=.false.
  150. else
  151. lsupfo=.true.
  152. CALL IDFORC(MFR,IFOUR,MOFORC,NFOR,NFAC)
  153. endif
  154. C
  155. C TAILLE DES MELVAL A ALLOUER
  156. C
  157. N1PTEL=2
  158. N1EL=NBELEM
  159. N2PTEL=0
  160. N2EL=0
  161. C
  162. C CREATION DU MCHAML DE LA SOUS ZONE
  163. C
  164. N2=NFOR
  165. SEGINI MCHAML
  166. ICHAML(ISOUS)=MCHAML
  167. NS=1
  168. NCOSOU=NFOR
  169. SEGINI MPTVAL
  170. IVAFOR=MPTVAL
  171. NOMID=MOFORC
  172. SEGACT NOMID
  173. DO 1 ICOMP=1,NFOR
  174. NOMCHE(ICOMP)=LESOBL(ICOMP)
  175. TYPCHE(ICOMP)='REAL*8'
  176. SEGINI MELVAL
  177. IELVAL(ICOMP)=MELVAL
  178. IVAL(ICOMP)=MELVAL
  179. 1 CONTINUE
  180. C
  181. C TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  182. C
  183. NBROBL=0
  184. NBRFAC=0
  185. MOCARA=0
  186. NCARA=0
  187. NCARF=0
  188. NCARR=0
  189. C
  190. C CARACTERISTIQUES POUR LES TUYAUX
  191. C
  192. NBROBL=3
  193. NBRFAC=2
  194. SEGINI NOMID
  195. MOCARA=NOMID
  196. LESOBL(1)='EPAI'
  197. LESOBL(2)='RAYO'
  198. LESOBL(3)='PRES'
  199. LESFAC(1)='RACO'
  200. LESFAC(2)='VECT'
  201. *
  202. NBTYPE=5
  203. SEGINI NOTYPE
  204. MOTYPE=NOTYPE
  205. TYPE(1)='REAL*8'
  206. TYPE(2)='REAL*8'
  207. TYPE(3)='REAL*8'
  208. TYPE(4)='REAL*8'
  209. TYPE(5)='POINTEURPOINT '
  210. C
  211. CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  212. SEGSUP NOTYPE
  213. IF (IERR.NE.0) GOTO 9990
  214. MPTVAL=IVACAR
  215. NCARA=NBROBL
  216. NCARF=NBRFAC
  217. NCARR=NCARA+NCARF
  218. C
  219. IF (ISUP.EQ.1) THEN
  220. MINTE=IPMINT
  221. SEGACT,MINTE
  222. CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  223. IF(IERR.NE.0)THEN
  224. ISUP=0
  225. GOTO 9990
  226. ENDIF
  227. ENDIF
  228. C
  229. C CALCUL DES FORCES DE PRESSION
  230. C
  231. CALL FPELTU(0,IVACAR,IPMAIL,ISOUS,IVAFOR)
  232. C
  233. C
  234. NOMID=MOCARA
  235. IF (MOCARA.NE.0) SEGSUP NOMID
  236. IF (ISUP.EQ.1) THEN
  237. CALL DTMVAL(IVACAR,3)
  238. ELSE
  239. CALL DTMVAL(IVACAR,1)
  240. ENDIF
  241. C
  242. NOMID=MOFORC
  243. if(lsupfo)SEGSUP NOMID
  244. CALL DTMVAL(IVAFOR,1)
  245. C
  246. C
  247. 101 CONTINUE
  248. IRET = 1
  249. CALL CHAMPO(ICHAM,0,IPTFP,IRET)
  250. CALL DTCHAM(ICHAM)
  251. RETURN
  252. C
  253. 9990 CONTINUE
  254. IRET=0
  255. C
  256. C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  257. C
  258. NOMID=MOCARA
  259. IF (MOCARA.NE.0) SEGSUP NOMID
  260. IF (ISUP.EQ.1) THEN
  261. CALL DTMVAL(IVACAR,3)
  262. ELSE
  263. CALL DTMVAL(IVACAR,1)
  264. ENDIF
  265. C
  266. NOMID=MOFORC
  267. if(lsupfo)SEGSUP NOMID
  268. CALL DTMVAL(IVAFOR,1)
  269. C
  270. SEGSUP MCHELM
  271.  
  272. END
  273.  
  274.  
  275.  

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