Esope source files

   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
  52 :          call erreur (21)
  53 :          RETURN
  54 :       ENDIF
  55 : 
  56 : C      mptval=ivacar
  57 : c      segact mptval    deja actif
  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
  66 :          call MASSX(ivamat,ivacar,NMATT,CMATE,
  67 :      &              imodel,LOCIRI)
  68 : c
  69 : ccccc de combien faut-il augmenter INFELE ?
  70 : C     write(ioimp,*) '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(ioimp,*) 'on n a meme pas reussi a construire des ',
  77 :      &                'rigidites associees aux ddl std'
  77 :         CALL ERREUR(21)
  78 :         return
  79 :       endif
  80 : c      write(ioimp,*) 'nrigsup=',nrigsup
  81 : C      if (nrigsup.gt.0)
  82 : C     & write(ioimp,*) 'on doit augmenter IRIGEL de MASS de',nrigsup,
  83 : C     & ' rigidites elementaires'
  84 : 
  85 : c      write(ioimp,*) 'ccccc on ouvre en modification MRIGID'
  86 :       MRIGID=IPMASS
  87 :       segact,MRIGID*mod
  88 : 
  89 :       NRIGE   = IRIGEL(/1)
  90 :       nrigini = IRIGEL(/2)
  91 :       NRIGEL  = nrigini + nrigsup
  92 :       IF (nrigsup.gt.0) then
  93 :         segadj,MRIGID
  94 :       ENDIF
  95 : 
  96 : c      write(ioimp,*) 'ccccc remplissage de MRIGID'
  97 : *
  98 : c  Cas ou il ya une partie std -----------------------
  99 :       if (LOCIRI(1,1).ne.0) then
 100 : *
 101 : c   + partie non enrichie (=std)
 102 :         do i1 = 1, NRIGE
 103 :           IRIGEL(i1,isouss)=LOCIRI(i1,1)
 104 :         enddo
 105 :         COERIG(isouss)= 1.D0
 106 : 
 107 : c   + partie enrichie
 108 :         if (nrigsup.gt.0) then
 109 : C       write(ioimp,*) 'c       modification de la taille de MRIGID de MASS'
 110 : C     &                ,isouss,'->',isouss+nrigsup
 111 :           ia = ISOUSS
 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 : C         write(ioimp,*) 'massxr: nrigini,ia,iloc=',nrigini,ia,iloc
 119 :             if( (LOCIRI(1,iloc)) .eq. 0)    goto 1000
 120 :             do i1 = 1,NRIGE
 121 : C     write(ioimp,*)'IRIGEL(',i1,ia,')=LOCIRI(',i1,iloc,')=',LOCIRI(i1,iloc)
 122 :               IRIGEL(i1,ia) = LOCIRI(i1,iloc)
 123 :             enddo
 124 :             COERIG(ia)= 1.D0
 125 :           enddo
 126 :           ISOUSS = ISOUSS + nrigsup
 127 :         endif 
 128 : c
 129 : c  Cas ou il n y a pas (plus) de partie std -----------------------
 130 :       ELSE
 131 :       
 132 : c   + partie enrichie
 133 :         ia = ISOUSS - 1
 134 :         iloc = 1
 135 :         do i = 0, nrigsup
 136 :           ia = ia + 1
 137 : c         petit ajout pour le cas ou on a "sauté" le H-enrichissement
 138 :  2000     continue
 139 :           iloc = iloc + 1
 140 :           if( (LOCIRI(1,iloc)) .eq. 0)    goto 2000
 141 :           do i1=1,NRIGE
 142 :             IRIGEL(i1,ia) = LOCIRI(i1,iloc)
 143 :           enddo
 144 :           COERIG(ia)= 1.D0
 145 :         enddo
 146 :         ISOUSS = ISOUSS + nrigsup
 147 : 
 148 :       endif 
 149 : *
 150 : c      write(ioimp,*) 'IRIGEL=',(IRIGEL(1,iou),iou=1,NRIGEL)
 151 : 
 152 :       return
 153 :       end
 154 :  
 155 :