Sources Esope | Cast3M

rigixr
C RIGIXR    SOURCE    OF166741  25/02/21    21:18:21     12166          
      subroutine RIGIXR(ISOU,IPOI6,IMODEL,IPINF,
     $       IVAMAT,IVACAR,NMATT,CMATE,NCAR1,NBGMAT,NELMAT,IMAT,IRETER)
* as 2009/09/03 : ajout de IMAT en entrée de RIGIXR
c
C Les sous programmes affectés à un type d'élément sont chargés
C de faire le tri des éléments suivant le type d'enrichissement.
c
C Par exemple le XQ4R peut sortir :
c     - des matrices ne comportant que des ddl standard du QUA4,
c     - des matrices enrichies par le saut du à la fissure,
c     - des matrices enrichies par le saut et par les fonctions de
c       la mécanique de la rupture
c
C Donc pour 1 type d'EF, on crée 1+NENR objet elementaire IMATTT
C Pour y parvenir, on utilise le tableau LOCIRI (=LOCal IRIgel)
c qui est l'équivalent local de IRIGEL et qui doit etre rempli
C par les sous programmes élémentaires (comme RIGIX.eso).
c Il est dimensionné en dur à (10,6) au lieu de (8,1+NENR)
c pour etre large.
C
C Finalement, RIGIXR.eso recupere LOCIRI, ajuste et remplit IRIGEL
c
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMRIGID
-INC SMINTE
-INC SMMODEL
-INC SMELEME
 
-INC TMPTVAL
 
      CHARACTER*8 CMATE
      PARAMETER (NBENRMAX=30)
      INTEGER    LOCIRI(10,(1+NBENRMAX))
 
c      write(6,*) '##### entree dans rigixr #####'
      IRETER=0
C
Ccccc on active le modele, les caracteristiques materiau
c*      segact,imodel
 
      mele = nefmod
C     element XQ4R (2D rupture) ou  element XC8R (3D rupture)
      IF (mele.NE.263 .and. mele.NE.264) then
        call erreur (21)
        RETURN
      ENDIF
 
c*      mptval=ivacar
c*      segact mptval
 
Ccccc on initialise LOCIRI
      do i1=1,10
       do i2=1,(1+NBENRMAX)
         LOCIRI(i1,i2) = 0
       enddo
      enddo
C
ccccc Appel au calcul des rigidites elementaires
       call rigix(ivamat,ivacar,NMATT,CMATE,
     &            imodel,IPINF,LOCIRI,NBGMAT,NELMAT,IMAT)
* as 2009/09/03 : ajout de IMAT en entrée de RIGIX
ccccc de combien faut-il augmenter INFELE ?
c      write(6,*) 'LOCIRI=',(LOCIRI(1,iou),iou=1,5)
      nrigsup = -1
      do i=1,(1+NBENRMAX)
        if (LOCIRI(1,i).ne.0)  nrigsup=nrigsup+1
      enddo
      if (nrigsup.eq.-1) then
       write(*,*) 'on n a meme pas reussi a construire des rigidite',
     & 'associes aux ddl std'
       CALL ERREUR(21)
       return
      endif
 
c      write(*,*) 'ccccc on ouvre en modification MRIGID'
      MRIGID=IPOI6
      segact,MRIGID*mod
 
      NRIGE   = IRIGEL(/1)
      nrigini = IRIGEL(/2)
      NRIGEL  = nrigini + nrigsup
      if (nrigsup.gt.0) then
C       write(ioimp,*) 'c       modification de la taille de MRIGID de RIGI'
C     &                ,isou,'->',isou+nrigsup
c       write(ioimp,*) 'on doit augmenter IRIGEL de',nrigsup,
c     & ' rigidites elementaires'
        segadj,MRIGID
      ENDIF
c      write(*,*) 'ccccc remplissage de MRIGID'
 
c  Cas ou il ya une partie std -----------------------
      IF (LOCIRI(1,1).ne.0) THEN
 
c   + partie non enrichie (=std)
        do i1 = 1, NRIGE
          IRIGEL(i1,isou)=LOCIRI(i1,1)
        enddo
        COERIG(isou)= 1.D0
 
c   + partie enrichie
        if (nrigsup.gt.0) then
          ia = isou
          iloc = 1
          do i = 1, nrigsup
            ia = ia + 1
c         petit ajout pour le cas ou on a "sauté" le H-enrichissement
 1000       continue
            iloc = iloc + 1
            if( (LOCIRI(1,iloc)) .eq. 0)    goto 1000
            do i1 = 1,NRIGE
              IRIGEL(i1,ia) = LOCIRI(i1,iloc)
            enddo
            COERIG(ia)= 1.D0
          enddo
          isou = isou + nrigsup
        endif
 
c   Cas ou il n y a pas (plus) de partie std -----------------------
      ELSE
 
c   + partie enrichie
        ia = isou - 1
        iloc = 1
        do i=0, nrigsup
          ia = ia + 1
c         petit ajout pour le cas ou on a "sauté" le H-enrichissement
 2000       continue
            iloc = iloc + 1
          if( (LOCIRI(1,iloc)) .eq. 0)    goto 2000
          do i1=1,NRIGE
            IRIGEL(i1,ia) = LOCIRI(i1,iloc)
          enddo
          COERIG(ia)= 1.D0
        enddo
        isou = isou + nrigsup
 
      ENDIF
 
c      write(ioimp,*) 'IRIGEL=',(IRIGEL(1,iou),iou=1,NRIGEL)
 
      return
      end