Télécharger massxr.eso

Retour à la liste

Numérotation des lignes :

  1. C MASSXR SOURCE FANDEUR 11/07/19 21:16:36 7041
  2.  
  3. subroutine MASSXR (ISOUSS,IMODEL,
  4. $ IVAMAT,IVACAR,NMATT,CMATE,
  5. $ IIPDPG,IPMASS,IRETER)
  6. C
  7. C Les sous programmes affectés à un type d'élément sont chargés
  8. C de faire le tri des éléments suivant le type d'enrichissement.
  9. c
  10. C Par exemple le XQ4R peut sortir :
  11. c - des matrices ne comportant que des ddl standard du QUA4,
  12. c - des matrices enrichies par le saut du à la fissure,
  13. c - des matrices enrichies par le saut et par les fonctions de
  14. c la mécanique de la rupture
  15. c
  16. C Donc pour 1 type d'EF, on crée 1+NENR objet elementaire IMATTT
  17. C Pour y parvenir, on utilise le tableau LOCIRI (=LOCal IRIgel)
  18. c qui est l'équivalent local de IRIGEL et qui doit etre rempli
  19. C par les sous programmes élémentaires (comme MASSX.eso).
  20. c Il est dimensionné en dur à (10,6) au lieu de (8,1+NENR)
  21. c pour etre large.
  22. C
  23. C Finalement, MASSXR.eso recupere LOCIRI, ajuste et remplit IRIGEL
  24. c
  25. IMPLICIT REAL*8 (A-H,O-Z)
  26. IMPLICIT INTEGER (I-N)
  27. C
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMRIGID
  32. -INC SMINTE
  33. -INC SMMODEL
  34. -INC SMELEME
  35. C
  36. CHARACTER*8 CMATE
  37. PARAMETER (NBENRMAX=5)
  38. INTEGER LOCIRI(10,(1+NBENRMAX))
  39. c
  40. SEGMENT MPTVAL
  41. INTEGER IPOS(NS),NSOF(NS)
  42. INTEGER IVAL(NCOSOU)
  43. CHARACTER*16 TYVAL(NCOSOU)
  44. ENDSEGMENT
  45. c
  46. c write(ioimp,*) '##### entree dans MASSxr #####'
  47. IRETER=0
  48. C
  49. Ccccc on active le modele, les caracteristiques materiau
  50. c segact,imodel deja actif
  51. mele = nefmod
  52.  
  53. C element XQ4R (2D rupture) ou element XC8R (3D rupture)
  54. IF (mele.ne.263 .and. mele.ne.264) then
  55. call erreur (21)
  56. RETURN
  57. ENDIF
  58.  
  59. C mptval=ivacar
  60. c segact mptval deja actif
  61.  
  62. Ccccc on initialise LOCIRI
  63. do i1=1,10
  64. do i2=1,(1+NBENRMAX)
  65. LOCIRI(i1,i2) = 0
  66. enddo
  67. enddo
  68. C
  69. ccccc Appel au calcul des rigidites elementaires
  70. call MASSX(ivamat,ivacar,NMATT,CMATE,
  71. & imodel,LOCIRI)
  72. c
  73. ccccc de combien faut-il augmenter INFELE ?
  74. C write(ioimp,*) 'LOCIRI=',(LOCIRI(1,iou),iou=1,5)
  75. nrigsup = -1
  76. do i=1,(1+NBENRMAX)
  77. if(LOCIRI(1,i).ne.0) nrigsup=nrigsup+1
  78. enddo
  79. if (nrigsup.eq.-1) then
  80. write(ioimp,*) 'on n a meme pas reussi a construire des ',
  81. & 'rigidites associees aux ddl std'
  82. CALL ERREUR(21)
  83. return
  84. endif
  85. c write(ioimp,*) 'nrigsup=',nrigsup
  86. C if (nrigsup.gt.0)
  87. C & write(ioimp,*) 'on doit augmenter IRIGEL de MASS de',nrigsup,
  88. C & ' rigidites elementaires'
  89.  
  90. c write(ioimp,*) 'ccccc on ouvre en modification MRIGID'
  91. MRIGID=IPMASS
  92. segact,MRIGID*mod
  93.  
  94. NRIGE = IRIGEL(/1)
  95. nrigini = IRIGEL(/2)
  96. NRIGEL = nrigini + nrigsup
  97. IF (nrigsup.gt.0) then
  98. segadj,MRIGID
  99. ENDIF
  100.  
  101. c write(ioimp,*) 'ccccc remplissage de MRIGID'
  102. *
  103. c Cas ou il ya une partie std -----------------------
  104. if (LOCIRI(1,1).ne.0) then
  105. *
  106. c + partie non enrichie (=std)
  107. do i1 = 1, NRIGE
  108. IRIGEL(i1,isouss)=LOCIRI(i1,1)
  109. enddo
  110. COERIG(isouss)= 1.D0
  111.  
  112. c + partie enrichie
  113. if (nrigsup.gt.0) then
  114. C write(ioimp,*) 'c modification de la taille de MRIGID de MASS'
  115. C & ,isouss,'->',isouss+nrigsup
  116. ia = ISOUSS
  117. iloc = 1
  118. do i = 1, nrigsup
  119. ia = ia + 1
  120. c petit ajout pour le cas ou on a "sauté" le H-enrichissement
  121. 1000 continue
  122. iloc = iloc + 1
  123. C write(ioimp,*) 'massxr: nrigini,ia,iloc=',nrigini,ia,iloc
  124. if( (LOCIRI(1,iloc)) .eq. 0) goto 1000
  125. do i1 = 1,NRIGE
  126. C write(ioimp,*)'IRIGEL(',i1,ia,')=LOCIRI(',i1,iloc,')=',LOCIRI(i1,iloc)
  127. IRIGEL(i1,ia) = LOCIRI(i1,iloc)
  128. enddo
  129. COERIG(ia)= 1.D0
  130. enddo
  131. ISOUSS = ISOUSS + nrigsup
  132. endif
  133. c
  134. c Cas ou il n y a pas (plus) de partie std -----------------------
  135. ELSE
  136.  
  137. c + partie enrichie
  138. ia = ISOUSS - 1
  139. iloc = 1
  140. do i = 0, nrigsup
  141. ia = ia + 1
  142. c petit ajout pour le cas ou on a "sauté" le H-enrichissement
  143. 2000 continue
  144. iloc = iloc + 1
  145. if( (LOCIRI(1,iloc)) .eq. 0) goto 2000
  146. do i1=1,NRIGE
  147. IRIGEL(i1,ia) = LOCIRI(i1,iloc)
  148. enddo
  149. COERIG(ia)= 1.D0
  150. enddo
  151. ISOUSS = ISOUSS + nrigsup
  152.  
  153. endif
  154. *
  155. c write(ioimp,*) 'IRIGEL=',(IRIGEL(1,iou),iou=1,NRIGEL)
  156.  
  157. return
  158. end
  159.  
  160.  
  161.  

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