Télécharger bmtd.eso

Retour à la liste

Numérotation des lignes :

  1. C BMTD SOURCE PV 20/03/30 21:15:34 10567
  2. SUBROUTINE BMTD
  3. C-----------------------------------------------------------------------
  4. C -1 t
  5. C Calcul du produit B M D CHPcentre
  6. C le résultat est un CHPface
  7. C-----------------------------------------------------------------------
  8. C
  9. C---------------------------
  10. C Phrase d'appel (GIBIANE) :
  11. C---------------------------
  12. C
  13. C CHP2 = 'BMTD' MMODEL RIG1 CHP1 ;
  14. C
  15. C------------------------
  16. C Operandes et resultat :
  17. C------------------------
  18. C
  19. C MMODEL : MODELE permettant de récuperer la TABLE DOMAINE
  20. C contenant les maillages et les connectivités.
  21. C On attend un modèle DARCY
  22. C RIG1 : Matrices hybrides elementaires de DARCY crees par MHYB.
  23. C CHP1 : CHPO centre à plusieur composantes.
  24. C CHP2 : CHPO face à plusieur composantes dont le support géometrique
  25. C est le maillage de la rigidité les noms des composantes
  26. C sont ceux de CHP1
  27. C
  28. C-----------------------------------------------------------------------
  29. C
  30. C Langage : ESOPE + FORTRAN77
  31. C
  32. C
  33. C-----------------------------------------------------------------------
  34. IMPLICIT INTEGER(I-N)
  35. IMPLICIT REAL*8 (A-H,O-Z)
  36. *
  37. -INC CCOPTIO
  38. -INC SMCOORD
  39. -INC SMCHPOI
  40. -INC SMELEME
  41. -INC SMRIGID
  42. -INC SMTABLE
  43. -INC SMMODEL
  44. *
  45. SEGMENT ICCPR
  46. INTEGER ICPR(NNGOT)
  47. ENDSEGMENT
  48. *
  49. LOGICAL LOGRE,LOGIN
  50. CHARACTER*8 TAPIND,CHARRE,LETYPE
  51. CHARACTER*4 NOMTOT(1)
  52. *
  53. * Initialisations
  54. *
  55. IVALIN = 0
  56. XVALIN = 0.D0
  57. LOGIN = .TRUE.
  58. IOBIN = 0
  59. TAPIND = 'MOT '
  60. *
  61. *
  62. * Lecture du MMODEL
  63. *
  64. CALL LIROBJ('MMODEL ',IPMODE,1,IRET)
  65. CALL ACTOBJ('MMODEL ',IPMODE,1)
  66. IF(IERR.NE.0)RETURN
  67. MMODEL=IPMODE
  68. SEGACT MMODEL
  69. N1=KMODEL(/1)
  70. DO 7 I=1,N1
  71. IMODEL=KMODEL(I)
  72. SEGACT IMODEL
  73. IF(FORMOD(1).NE.'DARCY')THEN
  74. MOTERR(1:16) = 'DARCY '
  75. CALL ERREUR(719)
  76. RETURN
  77. ENDIF
  78. 7 CONTINUE
  79. C on récupère la table DOMAINE
  80. IPTABL = 0
  81. CALL LEKMOD(MMODEL,IPTABL,IRET)
  82. IF (IERR.NE.0) RETURN
  83. *
  84. CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  85. IF (IERR.NE.0) RETURN
  86. IELTFA = IOBRE
  87. CALL LEKTAB(IPTABL,'CENTRE',IOBRE)
  88. IF (IERR.NE.0) RETURN
  89. ICENTR = IOBRE
  90. CALL LEKTAB(IPTABL,'FACE',IOBRE)
  91. IF (IERR.NE.0) RETURN
  92. IFACE = IOBRE
  93. *
  94. * Lecture de RIGIDITE
  95. *
  96. CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET)
  97. IF (IERR.NE.0) RETURN
  98. MRIGID = IPRIGI
  99. *
  100. *
  101. *
  102. * Test du sous-type de la matrice de rigiditée récupérée
  103. *
  104. SEGACT MRIGID
  105. LETYPE = MTYMAT
  106. IF (LETYPE.NE.'DARCY') THEN
  107. MOTERR(1:8) = 'RIGIDITE'
  108. MOTERR(9:16) = 'DARCY '
  109. CALL ERREUR(79)
  110. SEGDES MRIGID
  111. GOTO 100
  112. ENDIF
  113. *
  114. * Controle des pointeurs de MELEME de la rigidité
  115. *
  116. NRIGEL=IRIGEL(/2)
  117. MELEME=IELTFA
  118. SEGACT MELEME
  119. NBSOUS=LISOUS(/1)
  120. IF(NBSOUS.EQ.0)THEN
  121. IF((NRIGEL.NE.1).OR.(IRIGEL(1,1).NE.MELEME))THEN
  122. MOTERR(1:8) = 'DARCY '
  123. MOTERR(9:16) = 'ELTFA '
  124. INTERR(1) = 1
  125. CALL ERREUR(698)
  126. SEGDES MRIGID
  127. GOTO 100
  128. ENDIF
  129. ELSE
  130. IF(NRIGEL.NE.NBSOUS)THEN
  131. MOTERR(1:8) = 'DARCY '
  132. MOTERR(9:16) = 'ELTFA '
  133. INTERR(1) = 1
  134. CALL ERREUR(698)
  135. SEGDES MRIGID
  136. GOTO 100
  137. ENDIF
  138. DO 10 ISOUS=1,NBSOUS
  139. IF (LISOUS(ISOUS).NE.IRIGEL(1,ISOUS)) THEN
  140. MOTERR(1:8) = 'DARCY '
  141. MOTERR(9:16) = 'ELTFA '
  142. INTERR(1) = ISOUS
  143. CALL ERREUR(698)
  144. SEGDES MRIGID
  145. GOTO 100
  146. ENDIF
  147. 10 CONTINUE
  148. ENDIF
  149. CALL LIROBJ('CHPOINT ',IPCHC,1,IRET)
  150. CALL ACTOBJ('CHPOINT ',IPCHC,1)
  151. IF(IRET.NE.1) RETURN
  152. MCHPO1=IPCHC
  153. NOMTOT(1)=' '
  154. NBCOMP=-1
  155. CALL QUEPOI(MCHPO1,ICENTR,INDIC,NBCOMP,NOMTOT)
  156. IF(IERR.NE.0)RETURN
  157. SEGACT MCHPO1
  158. MSOUP1=MCHPO1.IPCHP(1)
  159. SEGACT MSOUP1
  160. MPOVA1=MSOUP1.IPOVAL
  161. SEGACT MPOVA1
  162. *
  163. * Construction de MCHPOI
  164. *
  165. *
  166. IPT2=IFACE
  167. SEGACT IPT2
  168. NPN=IPT2.NUM(/2)
  169. NSOUPO=1
  170. NAT=1
  171. SEGINI MCHPOI
  172. MTYPOI=' '
  173. MOCHDE=' CHPOIN CREE PAR BMTD '
  174. IFOPOI=IFOUR
  175. JATTRI(1)=2
  176. NC=NBCOMP
  177. SEGINI MSOUPO
  178. IPCHP(1)=MSOUPO
  179. DO 5 L=1,NBCOMP
  180. NOCOMP(L)=MSOUP1.NOCOMP(L)
  181. NOHARM(L)=MSOUP1.NOHARM(L)
  182. 5 CONTINUE
  183. IGEOC=IFACE
  184. N=NPN
  185. SEGINI MPOVAL
  186. IPOVAL=MPOVAL
  187. NB=N*NC
  188. CALL INITD(VPOCHA,NB,0.D0)
  189. *
  190. * Creation du tableau ICPR
  191. *
  192. IK = 0
  193. NNGOT = nbpts
  194. SEGINI ICCPR
  195. C MELEME = IFACE
  196. C SEGACT MELEME
  197. N2 = IPT2.NUM(/2)
  198. DO 15 I2=1,N2
  199. K = IPT2.NUM(1,I2)
  200. IF (ICPR(K).EQ.0) THEN
  201. IK = IK + 1
  202. ICPR(K) = IK
  203. ENDIF
  204. 15 CONTINUE
  205. SEGDES IPT2
  206. C
  207. C Calcul du produit
  208. C
  209. ITELEM=0
  210. MELEME=IELTFA
  211. C call ecmail(meleme)
  212. SEGACT MELEME
  213. IPT1=MELEME
  214. DO 50 ISOUS=1,NRIGEL
  215. IF(NRIGEL.NE.1)IPT1= LISOUS(ISOUS)
  216. SEGACT IPT1
  217. xMATRI=IRIGEL(4,ISOUS)
  218. SEGACT xMATRI
  219. NELRIG=re(/3)
  220. DO 60 IEL=1,NELRIG
  221. ITELEM=ITELEM+1
  222. * XMATRI=IMATTT(IEL)
  223. * SEGACT XMATRI
  224. NLIGRD=RE(/1)
  225. NLIGRP=RE(/2)
  226. DO 40 I=1,NLIGRD
  227. RLIGN=0.D0
  228. DO 30 J=1,NLIGRP
  229. RLIGN=RLIGN+RE(I,J,iel)
  230. 30 CONTINUE
  231. IPOPTS=ICPR(IPT1.NUM(I,IEL))
  232. DO 20 K=1,NBCOMP
  233. VPOCHA(IPOPTS,K)=VPOCHA(IPOPTS,K)+RLIGN*
  234. * MPOVA1.VPOCHA(ITELEM,K)
  235. 20 CONTINUE
  236.  
  237. 40 CONTINUE
  238. * SEGDES XMATRI
  239. 60 CONTINUE
  240. SEGDES xMATRI
  241. SEGDES IPT1
  242. 50 CONTINUE
  243. IF(NRIGEL.NE.1)SEGDES MELEME
  244. SEGDES MRIGID
  245. CALL ACTOBJ('CHPOINT ',MCHPOI,1)
  246. CALL ECROBJ('CHPOINT ',MCHPOI)
  247. *
  248. * Ménage
  249. *
  250. SEGSUP ICCPR
  251. 100 CONTINUE
  252. END
  253.  
  254.  
  255.  
  256.  

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