Télécharger rigixr.eso

Retour à la liste

Numérotation des lignes :

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

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