Esope source files

   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
  51 :         call erreur (21)
  52 :         RETURN
  53 :       ENDIF
  54 : 
  55 : c*      mptval=ivacar
  56 : c*      segact mptval
  57 : 
  58 : Ccccc on initialise LOCIRI
  59 :       do i1=1,10
  60 :        do i2=1,(1+NBENRMAX)
  61 :          LOCIRI(i1,i2) = 0
  62 :        enddo
  63 :       enddo
  64 : C
  65 : ccccc Appel au calcul des rigidites elementaires
  65 :        call rigix(ivamat,ivacar,NMATT,CMATE,
  66 :      &            imodel,IPINF,LOCIRI,NBGMAT,NELMAT,IMAT)
  67 : * as 2009/09/03 : ajout de IMAT en entrée de RIGIX
  68 : 
  69 : ccccc de combien faut-il augmenter INFELE ?
  70 : c      write(6,*) 'LOCIRI=',(LOCIRI(1,iou),iou=1,5)
  71 :       nrigsup = -1
  72 :       do i=1,(1+NBENRMAX)
  73 :         if (LOCIRI(1,i).ne.0)  nrigsup=nrigsup+1
  74 :       enddo
  75 :       if (nrigsup.eq.-1) then
  76 :        write(*,*) 'on n a meme pas reussi a construire des rigidite',
  77 :      & 'associes aux ddl std'
  77 :        CALL ERREUR(21)
  78 :        return
  79 :       endif
  80 : 
  81 : c      write(*,*) 'ccccc on ouvre en modification MRIGID'
  82 :       MRIGID=IPOI6
  83 :       segact,MRIGID*mod
  84 : 
  85 :       NRIGE   = IRIGEL(/1)
  86 :       nrigini = IRIGEL(/2)
  87 :       NRIGEL  = nrigini + nrigsup
  88 :       if (nrigsup.gt.0) then
  89 : C       write(ioimp,*) 'c       modification de la taille de MRIGID de RIGI'
  90 : C     &                ,isou,'->',isou+nrigsup
  91 : c       write(ioimp,*) 'on doit augmenter IRIGEL de',nrigsup,
  92 : c     & ' rigidites elementaires'
  93 :         segadj,MRIGID
  94 :       ENDIF
  95 : c      write(*,*) 'ccccc remplissage de MRIGID'
  96 : 
  97 : c  Cas ou il ya une partie std -----------------------
  98 :       IF (LOCIRI(1,1).ne.0) THEN
  99 :       
 100 : c   + partie non enrichie (=std)
 101 :         do i1 = 1, NRIGE
 102 :           IRIGEL(i1,isou)=LOCIRI(i1,1)
 103 :         enddo
 104 :         COERIG(isou)= 1.D0
 105 : 
 106 : c   + partie enrichie
 107 :         if (nrigsup.gt.0) then
 108 :           ia = isou
 109 :           iloc = 1
 110 :           do i = 1, nrigsup
 111 :             ia = ia + 1
 112 : c         petit ajout pour le cas ou on a "sauté" le H-enrichissement
 113 :  1000       continue
 114 :             iloc = iloc + 1
 115 :             if( (LOCIRI(1,iloc)) .eq. 0)    goto 1000
 116 :             do i1 = 1,NRIGE
 117 :               IRIGEL(i1,ia) = LOCIRI(i1,iloc)
 118 :             enddo
 119 :             COERIG(ia)= 1.D0
 120 :           enddo
 121 :           isou = isou + nrigsup
 122 :         endif 
 123 :         
 124 : c   Cas ou il n y a pas (plus) de partie std -----------------------
 125 :       ELSE
 126 :       
 127 : c   + partie enrichie
 128 :         ia = isou - 1
 129 :         iloc = 1
 130 :         do i=0, nrigsup
 131 :           ia = ia + 1
 132 : c         petit ajout pour le cas ou on a "sauté" le H-enrichissement
 133 :  2000       continue
 134 :             iloc = iloc + 1
 135 :           if( (LOCIRI(1,iloc)) .eq. 0)    goto 2000
 136 :           do i1=1,NRIGE
 137 :             IRIGEL(i1,ia) = LOCIRI(i1,iloc)
 138 :           enddo
 139 :           COERIG(ia)= 1.D0
 140 :         enddo
 141 :         isou = isou + nrigsup
 142 : 
 143 :       ENDIF 
 144 : *
 145 : c      write(ioimp,*) 'IRIGEL=',(IRIGEL(1,iou),iou=1,NRIGEL)
 146 : c
 147 :       return
 148 :       end
 149 : 
 150 :