Télécharger sqtp1.eso

Retour à la liste

Numérotation des lignes :

sqtp1
  1. C SQTP1 SOURCE FANDEUR 22/01/03 21:15:47 11136
  2. SUBROUTINE SQTP1(IPMAHY,IPFACE,IPFORC,IPMATP,
  3. S IFORC,IORIE,INORM,ISURF,MCHPOI)
  4. C-----------------------------------------------------------------------
  5. C Calcul de la contribution au systeme en trace de charge d'une force
  6. C volumique dans le cas de la résolution des équations de Darcy par EFMH
  7. C avec le modèle DARCY.
  8. C-----------------------------------------------------------------------
  9. C
  10. C---------------------------
  11. C Parametres Entree/Sortie :
  12. C---------------------------
  13. C
  14. C E/ IPMAHY : Segment contenant le pointeur vers le meleme des
  15. C connectivites elements/faces pour les zones du MMODEL
  16. C ou on a defini DARCY.
  17. C E/ IPFACE : MELEME de type POI1 des faces
  18. C E/ IPFORC : RIGIDITE de sous type 'MASSE'
  19. C E/ IPMATP : RIGIDITE de sous type 'HYBTP'
  20. C E/ IFORC : CHPO centre des sources de composantes FX, FY, (FZ)
  21. C E/ IORIE : MCHAML orientation des normales
  22. C E/ INORM : CHPO face des normales
  23. C E/ ISURF : CHPO face des surfaces
  24. C /S MCHPOI : CHPOINT face de composante FLUX
  25. C
  26. C----------------------
  27. C Variables en COMMON :
  28. C----------------------
  29. C
  30. C E/ IFOMOD : cf CCOPTIO
  31. C E/ NIFOUR : cf CCOPTIO
  32. C E/ IDIM : cf CCOPTIO
  33. C
  34. C
  35. C-----------------------------------------------------------------------
  36. C
  37. C Langage : ESOPE + FORTRAN77
  38. C
  39. C Auteurs : 02/96 L.V.BENET - Cas permanent
  40. C
  41. C-----------------------------------------------------------------------
  42. IMPLICIT INTEGER(I-N)
  43. IMPLICIT REAL*8 (A-H,O-Z)
  44. *
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC CCHAMP
  49. -INC SMCOORD
  50. -INC SMCHPOI
  51. -INC SMCHAML
  52. -INC SMELEME
  53. -INC SMRIGID
  54. *
  55. SEGMENT IPMAHY
  56. INTEGER MAHYBR(NSOUS)
  57. ENDSEGMENT
  58. SEGMENT ICCPR
  59. INTEGER ICPR(NNGOT)
  60. ENDSEGMENT
  61. SEGMENT MTRAV
  62. REAL*8 RLIGN1(NBDDL),RLIGN2(NBDDL)
  63. ENDSEGMENT
  64. *
  65. *- Initialisations
  66. *
  67. MCHPOI = 0
  68. *- Creation du tableau ICPR pour le MELEME POI1 IPFACE
  69. *
  70. IK = 0
  71. NNGOT = nbpts
  72. SEGINI ICCPR
  73. MELEME = IPFACE
  74. SEGACT MELEME
  75. N2 = NUM(/2)
  76. DO 10 I2=1,N2
  77. K = NUM(1,I2)
  78. IF (ICPR(K).EQ.0) THEN
  79. IK = IK + 1
  80. ICPR(K) = IK
  81. ENDIF
  82. 10 CONTINUE
  83. SEGDES MELEME
  84. *
  85. *- Creation du CHAMPOINT face - On laisse actif le MPOVAL du CHPOINT
  86. *
  87. NSOUPO = 1
  88. NAT = 1
  89. SEGINI MCHPOI
  90. IRET = MCHPOI
  91. MTYPOI = 'FACE '
  92. IFOPOI = IFOUR
  93. JATTRI(1) = 2
  94. NC = 1
  95. SEGINI MSOUPO
  96. IPCHP(1) = MSOUPO
  97. SEGDES MCHPOI
  98. NOHARM(1) = NIFOUR
  99. IGEOC = IPFACE
  100. NOCOMP(1) = 'FLUX'
  101. N = N2
  102. SEGINI MPOVAL
  103. IPOVAL = MPOVAL
  104. SEGDES MSOUPO
  105. *
  106. *- Recuperation du nombre de zone NBMAIL du MMODEL a partir IPMAHY
  107. *
  108. SEGACT IPMAHY
  109. NBMAIL = MAHYBR(/1)
  110. *
  111. *- Activation des segments RIGIDITE masse hybride et MATP
  112. *
  113. RI1 = IPFORC
  114. SEGACT RI1
  115. RI2 = IPMATP
  116. SEGACT RI2
  117. *
  118. *- Activation du segment MPOVAL du CHAMPOINT centre de composantes FX FY FZ
  119. *
  120. MCHPO1 = IFORC
  121. SEGACT MCHPO1
  122. MSOUP1 = MCHPO1.IPCHP(1)
  123. SEGDES MCHPO1
  124. SEGACT MSOUP1
  125. MPOVA1 = MSOUP1.IPOVAL
  126. SEGDES MSOUP1
  127. SEGACT MPOVA1
  128. *
  129. * Activation du MCHAML d'orientation des normales
  130. *
  131. MCHEL1 = IORIE
  132. SEGACT MCHEL1
  133.  
  134. *
  135. * Activation du CHPO des vecteurs normales
  136. *
  137. MCHPO2 = INORM
  138. SEGACT MCHPO2
  139. MSOUP2 = MCHPO2.IPCHP(1)
  140. SEGDES MCHPO2
  141. SEGACT MSOUP2
  142. MPOVA2 = MSOUP2.IPOVAL
  143. SEGDES MSOUP2
  144. SEGACT MPOVA2
  145. *
  146. * Activation du CHPO des surfaces
  147. *
  148. MCHPO3 = ISURF
  149. SEGACT MCHPO3
  150. MSOUP3 = MCHPO3.IPCHP(1)
  151. SEGDES MCHPO3
  152. SEGACT MSOUP3
  153. MPOVA3 = MSOUP3.IPOVAL
  154. SEGDES MSOUP3
  155. SEGACT MPOVA3
  156. *
  157. *--------------------------------------------------
  158. *= BOUCLE SUR LES MAILLAGES ELEMENTAIRES,ZONE IMAIL
  159. *--------------------------------------------------
  160. *
  161. * WRITE(*,*)' NBMAIL ',NBMAIL
  162. ITELEM = 0
  163. DO 110 IMAIL=1,NBMAIL
  164. C
  165. C- Activation de l'objet maillage ELTFA pour la zone IMAIL
  166. C
  167. MELEME = MAHYBR(IMAIL)
  168. IF (MELEME.EQ.0) GOTO 110
  169. SEGACT MELEME
  170. *
  171. *- Recuperation des caracteristiques de RIGIDITE de sous type MASSE
  172. *- pour la zone IMAIL en cours de traitement
  173. *
  174. xMATR1 = RI1.IRIGEL(4,IMAIL)
  175. SEGACT xMATR1
  176. NBELEM = xMATR1.re(/3)
  177. NELRIG = NBELEM
  178. * XMATR1 = IMATR1.IMATTT(1)
  179. * SEGACT XMATR1
  180. NBDDL = XMATR1.RE(/1)
  181. NLIGRP = NBDDL
  182. NLIGRD = NBDDL
  183. * SEGDES XMATR1
  184. *
  185. *- Recuperation des caracteristiques de RIGIDITE de sous type HYBTP
  186. *- pour la zone IMAIL en cours de traitement
  187. *
  188. xMATR2 = RI2.IRIGEL(4,IMAIL)
  189. SEGACT xMATR2
  190. NBELEM = xMATR2.re(/3)
  191. NELRIG = NBELEM
  192. * XMATR2 = IMATR2.IMATTT(1)
  193. * SEGACT XMATR2
  194. NBDDL = XMATR2.RE(/1)
  195. NLIGRP = NBDDL
  196. NLIGRD = NBDDL
  197. * SEGDES XMATR2
  198. SEGINI MTRAV
  199. *
  200. * Activation du segment contenant les valeurs du MCHAML d'orientation
  201. * des normales par face pour la zone IMAIL
  202. *
  203. MCHAM1 = MCHEL1.ICHAML(IMAIL)
  204. SEGACT MCHAM1
  205. MELVA1 = MCHAM1.IELVAL(1)
  206. SEGDES MCHAM1
  207. SEGACT MELVA1
  208. *
  209. *-------------------------------------------------------
  210. * BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  211. *-------------------------------------------------------
  212. *
  213. DO 100 IEL=1,NBELEM
  214. ITELEM = ITELEM + 1
  215. *
  216. *- calcul des flux de forces aux faces de l'element
  217. *
  218. DO 35 IDDL=1,NBDDL
  219. RLIGN1(IDDL)= 0.D0
  220. IPOPTS = ICPR(NUM(IDDL,IEL))
  221. DO 40 I=1,IDIM
  222. RLIGN1(IDDL) = RLIGN1(IDDL) + MPOVA2.VPOCHA(IPOPTS,I) *
  223. S MELVA1.VELCHE(IDDL,IEL) * MPOVA1.VPOCHA(ITELEM,I) *
  224. S MPOVA3.VPOCHA(IPOPTS,1)
  225. 40 CONTINUE
  226. 35 CONTINUE
  227. *
  228. *- Construction du tableau aux faces M.FORCE
  229. *
  230. * XMATR1 = IMATR1.IMATTT(IEL)
  231. * SEGACT XMATR1
  232. DO 45 I=1,NBDDL
  233. RLIGN2(I)= 0.D0
  234. DO 50 J=1,NBDDL
  235. RLIGN2(I)= RLIGN2(I) + XMATR1.RE(I,J,iel)*RLIGN1(J)
  236. 50 CONTINUE
  237. 45 CONTINUE
  238. * SEGDES XMATR1
  239. *
  240. *- Construction du CHPOINT aux faces HYBTP.(M.FORCE)
  241. *
  242. * XMATR2 = IMATR2.IMATTT(IEL)
  243. * SEGACT XMATR2
  244. DO 55 I=1,NBDDL
  245. IPOPTS = ICPR(NUM(I,IEL))
  246. DO 60 J=1,NBDDL
  247. VPOCHA(IPOPTS,1)=VPOCHA(IPOPTS,1) +
  248. S XMATR2.RE(I,J,iel)*RLIGN2(J)
  249. 60 CONTINUE
  250. 55 CONTINUE
  251. * SEGDES XMATR2
  252. 100 CONTINUE
  253. SEGDES xMATR1 , xMATR2
  254. SEGDES MELEME
  255. SEGDES MELVA1
  256. SEGSUP MTRAV
  257. 110 CONTINUE
  258. *
  259. *- Desactivation des segments
  260. *
  261. SEGDES MCHEL1
  262. SEGDES MPOVAL , MPOVA1 , MPOVA2 , MPOVA3
  263. SEGDES IPMAHY
  264. SEGDES RI1 , RI2
  265. SEGSUP ICCPR
  266. RETURN
  267. END
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  

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