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. -INC CCOPTIO
  29. -INC SMRIGID
  30. -INC SMINTE
  31. -INC SMMODEL
  32. -INC SMELEME
  33. C
  34. CHARACTER*8 CMATE
  35. PARAMETER (NBENRMAX=5)
  36. INTEGER LOCIRI(10,(1+NBENRMAX))
  37. c
  38. SEGMENT MPTVAL
  39. INTEGER IPOS(NS),NSOF(NS)
  40. INTEGER IVAL(NCOSOU)
  41. CHARACTER*16 TYVAL(NCOSOU)
  42. ENDSEGMENT
  43. c
  44. c write(ioimp,*) '##### entree dans MASSxr #####'
  45. IRETER=0
  46. C
  47. Ccccc on active le modele, les caracteristiques materiau
  48. c segact,imodel deja actif
  49. mele = nefmod
  50.  
  51. C element XQ4R (2D rupture) ou element XC8R (3D rupture)
  52. IF (mele.ne.263 .and. mele.ne.264) then
  53. call erreur (21)
  54. RETURN
  55. ENDIF
  56.  
  57. C mptval=ivacar
  58. c segact mptval deja actif
  59.  
  60. Ccccc on initialise LOCIRI
  61. do i1=1,10
  62. do i2=1,(1+NBENRMAX)
  63. LOCIRI(i1,i2) = 0
  64. enddo
  65. enddo
  66. C
  67. ccccc Appel au calcul des rigidites elementaires
  68. call MASSX(ivamat,ivacar,NMATT,CMATE,
  69. & imodel,LOCIRI)
  70. c
  71. ccccc de combien faut-il augmenter INFELE ?
  72. C write(ioimp,*) 'LOCIRI=',(LOCIRI(1,iou),iou=1,5)
  73. nrigsup = -1
  74. do i=1,(1+NBENRMAX)
  75. if(LOCIRI(1,i).ne.0) nrigsup=nrigsup+1
  76. enddo
  77. if (nrigsup.eq.-1) then
  78. write(ioimp,*) 'on n a meme pas reussi a construire des ',
  79. & 'rigidites associees aux ddl std'
  80. CALL ERREUR(21)
  81. return
  82. endif
  83. c write(ioimp,*) 'nrigsup=',nrigsup
  84. C if (nrigsup.gt.0)
  85. C & write(ioimp,*) 'on doit augmenter IRIGEL de MASS de',nrigsup,
  86. C & ' rigidites elementaires'
  87.  
  88. c write(ioimp,*) 'ccccc on ouvre en modification MRIGID'
  89. MRIGID=IPMASS
  90. segact,MRIGID*mod
  91.  
  92. NRIGE = IRIGEL(/1)
  93. nrigini = IRIGEL(/2)
  94. NRIGEL = nrigini + nrigsup
  95. IF (nrigsup.gt.0) then
  96. segadj,MRIGID
  97. ENDIF
  98.  
  99. c write(ioimp,*) 'ccccc remplissage de MRIGID'
  100. *
  101. c Cas ou il ya une partie std -----------------------
  102. if (LOCIRI(1,1).ne.0) then
  103. *
  104. c + partie non enrichie (=std)
  105. do i1 = 1, NRIGE
  106. IRIGEL(i1,isouss)=LOCIRI(i1,1)
  107. enddo
  108. COERIG(isouss)= 1.D0
  109.  
  110. c + partie enrichie
  111. if (nrigsup.gt.0) then
  112. C write(ioimp,*) 'c modification de la taille de MRIGID de MASS'
  113. C & ,isouss,'->',isouss+nrigsup
  114. ia = ISOUSS
  115. iloc = 1
  116. do i = 1, nrigsup
  117. ia = ia + 1
  118. c petit ajout pour le cas ou on a "sauté" le H-enrichissement
  119. 1000 continue
  120. iloc = iloc + 1
  121. C write(ioimp,*) 'massxr: nrigini,ia,iloc=',nrigini,ia,iloc
  122. if( (LOCIRI(1,iloc)) .eq. 0) goto 1000
  123. do i1 = 1,NRIGE
  124. C write(ioimp,*)'IRIGEL(',i1,ia,')=LOCIRI(',i1,iloc,')=',LOCIRI(i1,iloc)
  125. IRIGEL(i1,ia) = LOCIRI(i1,iloc)
  126. enddo
  127. COERIG(ia)= 1.D0
  128. enddo
  129. ISOUSS = ISOUSS + nrigsup
  130. endif
  131. c
  132. c Cas ou il n y a pas (plus) de partie std -----------------------
  133. ELSE
  134.  
  135. c + partie enrichie
  136. ia = ISOUSS - 1
  137. iloc = 1
  138. do i = 0, nrigsup
  139. ia = ia + 1
  140. c petit ajout pour le cas ou on a "sauté" le H-enrichissement
  141. 2000 continue
  142. iloc = iloc + 1
  143. if( (LOCIRI(1,iloc)) .eq. 0) goto 2000
  144. do i1=1,NRIGE
  145. IRIGEL(i1,ia) = LOCIRI(i1,iloc)
  146. enddo
  147. COERIG(ia)= 1.D0
  148. enddo
  149. ISOUSS = ISOUSS + nrigsup
  150.  
  151. endif
  152. *
  153. c write(ioimp,*) 'IRIGEL=',(IRIGEL(1,iou),iou=1,NRIGEL)
  154.  
  155. return
  156. end
  157.  
  158.  
  159.  

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