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

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