Télécharger dmtd.eso

Retour à la liste

Numérotation des lignes :

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

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