Télécharger dmtd.eso

Retour à la liste

Numérotation des lignes :

dmtd
  1. C DMTD SOURCE CB215821 20/11/25 13:25:53 10792
  2. SUBROUTINE DMTD
  3. C-----------------------------------------------------------------------
  4. C -1 t
  5. C Calcul du CHPOIN scalaire D M D
  6. C Somme des termes de chaque matrice elementaire pour former
  7. C un chpoin dont le support géométrique est le maillage TADOM.CENTRE
  8. C-----------------------------------------------------------------------
  9. C
  10. C---------------------------
  11. C Phrase d'appel (GIBIANE) :
  12. C---------------------------
  13. C
  14. C CHP1 = 'DMTD' MMODEL RIG1 ;
  15. C
  16. C------------------------
  17. C Operandes et resultat :
  18. C------------------------
  19. C
  20. C MMODEL : MODELE DARCY.
  21. C RIG1 : Matrices hybrides elementaires de DARCY crees par MHYB.
  22. C CHP1 : CHPO centre de composante SCAL coef par élément.
  23. C
  24. C-----------------------------------------------------------------------
  25. C
  26. C Langage : ESOPE + FORTRAN77
  27. C
  28. C
  29. C-----------------------------------------------------------------------
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8 (A-H,O-Z)
  32. *
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMCHPOI
  37. -INC SMELEME
  38. -INC SMRIGID
  39. -INC SMTABLE
  40. -INC SMMODEL
  41. *
  42. LOGICAL LOGRE,LOGIN
  43. CHARACTER*8 TAPIND,TYPOBJ,CHARRE,LETYPE
  44. *
  45. * Initialisations
  46. *
  47. IVALIN = 0
  48. XVALIN = 0.D0
  49. LOGIN = .TRUE.
  50. IOBIN = 0
  51. TAPIND = 'MOT '
  52. *
  53. *
  54. * Lecture du MMODEL
  55. *
  56. CALL LIROBJ('MMODEL',IPMODE,1,IRET)
  57. IF(IERR.NE.0)RETURN
  58. MMODEL=IPMODE
  59. SEGACT MMODEL
  60. N1=KMODEL(/1)
  61. DO 7 I=1,N1
  62. IMODEL=KMODEL(I)
  63. SEGACT IMODEL
  64. IF(FORMOD(1).NE.'DARCY')THEN
  65. MOTERR(1:16) = 'DARCY '
  66. CALL ERREUR(719)
  67. RETURN
  68. ENDIF
  69. 7 CONTINUE
  70. C
  71. C on récupère la table DOMAINE à partir du modèle
  72. C
  73. IPTABL = 0
  74. CALL LEKMOD(MMODEL,IPTABL,IRET)
  75. IF (IERR.NE.0) RETURN
  76. TYPOBJ = 'MAILLAGE'
  77. CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
  78. IF (IERR.NE.0) RETURN
  79. IELTFA = IOBRE
  80. CALL LEKTAB(IPTABL,'CENTRE',IOBRE)
  81. IF (IERR.NE.0) RETURN
  82. ICENTR = IOBRE
  83. *
  84. * Lecture de RIGIDITE
  85. *
  86. CALL LIROBJ('RIGIDITE',IPRIGI,1,IRET)
  87. IF (IERR.NE.0) RETURN
  88. MRIGID = IPRIGI
  89. *
  90. *
  91. *
  92. * Test du sous-type de la matrice de rigiditée récupérée
  93. *
  94. SEGACT MRIGID
  95. LETYPE = MTYMAT
  96. IF (LETYPE.NE.'DARCY') THEN
  97. MOTERR(1:8) = 'RIGIDITE'
  98. MOTERR(9:16) = 'DARCY '
  99. CALL ERREUR(79)
  100. SEGDES MRIGID
  101. GOTO 100
  102. ENDIF
  103. *
  104. * Controle des pointeurs de MELEME de la rigidité
  105. *
  106. NRIGEL=IRIGEL(/2)
  107. MELEME=IELTFA
  108. SEGACT MELEME
  109. NBSOUS=LISOUS(/1)
  110. IF(NBSOUS.EQ.0)THEN
  111. IF((NRIGEL.NE.1).OR.(IRIGEL(1,1).NE.MELEME))THEN
  112. MOTERR(1:8) = 'DARCY '
  113. MOTERR(9:16) = 'ELTFA '
  114. INTERR(1) = 1
  115. CALL ERREUR(698)
  116. SEGDES MRIGID
  117. GOTO 100
  118. ENDIF
  119. ELSE
  120. IF(NRIGEL.NE.NBSOUS)THEN
  121. MOTERR(1:8) = 'DARCY '
  122. MOTERR(9:16) = 'ELTFA '
  123. INTERR(1) = 1
  124. CALL ERREUR(698)
  125. SEGDES MRIGID
  126. GOTO 100
  127. ENDIF
  128. DO 10 ISOUS=1,NBSOUS
  129. IF (LISOUS(ISOUS).NE.IRIGEL(1,ISOUS)) THEN
  130. MOTERR(1:8) = 'DARCY '
  131. MOTERR(9:16) = 'ELTFA '
  132. INTERR(1) = ISOUS
  133. CALL ERREUR(698)
  134. SEGDES MRIGID
  135. GOTO 100
  136. ENDIF
  137. 10 CONTINUE
  138. ENDIF
  139. *
  140. * Construction de MCHPOI
  141. *
  142. *
  143. IPT1=ICENTR
  144. SEGACT IPT1
  145. NPN=IPT1.NUM(/2)
  146. NSOUPO=1
  147. NAT=1
  148. SEGINI MCHPOI
  149. MTYPOI=' '
  150. MOCHDE=' CHPOIN CREE PAR DMTD '
  151. IFOPOI=IFOUR
  152. JATTRI(1)=2
  153. NC=1
  154. SEGINI MSOUPO
  155. IPCHP(1)=MSOUPO
  156. NOCOMP(1)='SCAL'
  157. NOHARM(1)=0
  158. IGEOC=ICENTR
  159. N=NPN
  160. SEGINI MPOVAL
  161. IPOVAL=MPOVAL
  162. NB=N
  163. CALL INITD(VPOCHA,NB,0.D0)
  164. C
  165. C Calcul de la somme par element
  166. C
  167. ITELEM=0
  168. DO 50 ISOUS=1,NRIGEL
  169. xMATRI=IRIGEL(4,ISOUS)
  170. SEGACT xMATRI
  171. NELRIG=re(/3)
  172. DO 60 IEL=1,NELRIG
  173. ITELEM=ITELEM+1
  174. * XMATRI=IMATTT(IEL)
  175. * SEGACT XMATRI
  176. NLIGRD=RE(/1)
  177. NLIGRP=RE(/2)
  178. CONSD=0.D0
  179. DO 40 J=1,NLIGRP
  180. DO 30 I=1,NLIGRD
  181. CONSD=CONSD+RE(I,J,iel)
  182. 30 CONTINUE
  183. 40 CONTINUE
  184. VPOCHA(ITELEM,1)=CONSD
  185. * SEGDES XMATRI
  186. 60 CONTINUE
  187. SEGDES xMATRI
  188. 50 CONTINUE
  189. SEGDES MRIGID
  190. CALL ECROBJ('CHPOINT',MCHPOI)
  191. *
  192. * Ménage
  193. *
  194. SEGDES MPOVAL,MSOUPO,MCHPOI
  195. 100 CONTINUE
  196. RETURN
  197. END
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  

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