Sources Esope | Cast3M

elquoi
C ELQUOI    SOURCE    MB234859  25/09/08    21:15:21     12358          
 
C=======================================================================
C=                  Sous-programme ELQUOI                              =
C=                  ---------------------                              =
C=                                                                     =
C= Ce sous programme cree le(s) segment(s) d'integration               =
C=                                                                     =
C= Entrees :                                                           =
C= ---------                                                           =
C=   IMODEL    : pointeur sur un IMODEL, zone elementaire d'un MMODEL  =
C=   INTTYP    : type d'integration utilisee par l'operateur           =
C=                                                                     =
C= Sorties :                                                           =
C= ---------                                                           =
C=  Si INTTYP > 0 :                                                    =
C=   IPTR : pointeur sur le segment d'integration au support INTTYP    =
C=  Si INTTYP &lt; 0 :                                                    =
C=   Complete le table INFMOD selon :                                  =
C=             |ITYPI|                                                 =
C=   ----------------------------------------------------------------- =
C=   INFMOD(3) |  1  | NOEUDS  ( appel a RENOEU )                      =
C=   INFMOD(4) |  2  | points de GAUSS pour centre de GRAVITE          =
C=   INFMOD(5) |  3  | points de GAUSS pour la RIGIDITE                =
C=   INFMOD(6) |  4  | points de GAUSS pour la MASSE                   =
C=   INFMOD(7) |  5  | points de GAUSS pour les CONTRAINTES            =
C=             |  6  | pas de calcul de segment d'integration          =
C=             |  7  | FACE                                            =
C=             |  8  | CENTREP1                                        =
C=             |  9  | MSOMMET                                         =
C=   IPTR : pointeur sur le segment d'integration stockee a INFELE(11) =
C=======================================================================
      SUBROUTINE ELQUOI(IMODEL,INTTYP,IPTR)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC CCHAMP
C= DEB === Formulation HHO ===== Include specifique ====================
-INC CCHHOPA
C= FIN === Formulation HHO =============================================
-INC SMMODEL
-INC SMELEME
-INC SMLMOTS
-INC SMINTE
C=======================================================================
C= INTEGR : SAVE local des pointeurs sur les segments d'integration    =
C=          CAS GENERAL                                                =
C= NELFI  : Nombre de types d'element FINI (= LNOMTP de bdata.eso)     =
C= NBMODE : Nombre de MODEs de calcul (= nb valeurs possibles IFOMOD)  =
C= NTYNTE : Nombre de TYPEs de segment D'INTEGRATION possibles         =
C=          (voir la description de INTTYP ci-dessus)                  =
C= NINFOS : Dimension (JG) du tableau infell (segment INFO) = 16       =
C= On sauvegarde dans INTEGR(I,J) le pointeur sur un segment d'inte-   =
C= gration correspondant a l'element fini de type I et une integration =
C= de type J.                                                          =
C=======================================================================
C Valeurs de IFOMOD : -1     0     1     2     3     4     5     6
C                    PLAN  AXIS  FOUR  TRID  UNID  UNID  UNID  FREQ
C                                            PLAN  AXIS  SPHE
      PARAMETER ( NELFI = 300 , NTYNTE = 9 , NBMODE = 8 )
      PARAMETER ( NINTEG = NELFI * NTYNTE * NBMODE , NINFOS = 16 )
C
      INTEGER INTEGR(NELFI,NTYNTE,NBMODE)
      LOGICAL bstocke,bxelt
C
      SAVE INTEGR
      DATA INTEGR / NINTEG*0 /
C
C     Tests de verification :
      IF (NELFI.LT.LNOMTP) THEN
        WRITE(IOIMP,*)
        WRITE(IOIMP,*) 'ELQUOI : valeur de NELFI incorrecte !'
        WRITE(IOIMP,*) '         NELFI  = ',NELFI,LNOMTP
        CALL ERREUR(5)
        RETURN
      ENDIF
C
C     On se place sur la bonne "tranche" du tableau INTEGR :
      IBMODE = IFOMOD + 2
      IF (NBMODE.LT.IBMODE) THEN
        WRITE(IOIMP,*)
        WRITE(IOIMP,*) 'ELQUOI : valeur de NBMODE incorrecte !'
        WRITE(IOIMP,*) '         IBMODE = ',IBMODE,NBMODE,IFOMOD
        CALL ERREUR(5)
        RETURN
      ENDIF
C
      MELE = IMODEL.NEFMOD
C
      IF (MELE.GT.NELFI) THEN
        WRITE(IOIMP,*)
        WRITE(IOIMP,*) 'ELQUOI : incoherence NELFI & MELE ',NELFI,MELE
        CALL ERREUR(5)
        RETURN
      ENDIF
C
      IF (IMODEL.INFMOD(/1).LT.1) THEN
        WRITE(IOIMP,*)
        WRITE(IOIMP,*) 'ELQUOI : INFMOD(/1) incorrect',INFMOD(/1),' &lt; 1'
        CALL ERREUR(5)
      ENDIF
C
      NPINT = INFMOD(1)
      NBGM  = INFELE(3)
      NBGST = INFELE(4)
      NBG   = INFELE(6)
      NBSH  = INFELE(8)
      IELE  = INFELE(14)
C
      bstocke=(INTTYP.LT.0)
      IF (bstocke) THEN
        IDEB = 1
        IFIN = ABS(INTTYP)
      ELSE
        IDEB = INTTYP
        IFIN = IDEB
      ENDIF
C
      IDETY = 0
      bxelt=((MELE.EQ.263).OR.(MELE.EQ.264))
C     =================================================================
C     Cas particulier XFEM
C     =================================================================
      IF (bxelt) THEN
        DO 20 ITYPI=IDEB,IFIN
C
C         Infos pour l'element MELE, mode de calcul IBMODE deja creees
          IPT2=INTEGR(MELE,ITYPI,IBMODE)
          IF (IPT2.NE.0) GOTO 19
C
C         ---------------------------------------------------------------
C         1 : Segment d'integration aux noeuds
C         ---------------------------------------------------------------
          IF (ITYPI.EQ.1) THEN
            CALL RENOEU(IELE,MELE,NBSH,IPT2,IRT1)
C         ---------------------------------------------------------------
C         2 : Segment d'integration au centre de gravite
C         ---------------------------------------------------------------
          ELSE IF (ITYPI.EQ.2) THEN
              CALL RESHPT(1,NBSH,IELE,MELE,NPINT,IPT2,IRT1)
C         ---------------------------------------------------------------
C         3 : Segment d'integration pour la rigidite
C         ---------------------------------------------------------------
          ELSE IF (ITYPI.EQ.3) THEN
              CALL RESHPX(NBG,NBSH,IELE,MELE,NPINT,IPT2,IRT1)
C         ---------------------------------------------------------------
C         4 : Segment d'integration pour la masse
C         ---------------------------------------------------------------
          ELSE IF (ITYPI.EQ.4) THEN
              CALL RESHPX(NBGM,NBSH,IELE,MELE,NPINT,IPT2,IRT1)
C         ---------------------------------------------------------------
C         5 : Segment d'integration pour les contraintes
C         ---------------------------------------------------------------
          ELSE IF (ITYPI.EQ.5) THEN
              CALL RESHPX(NBG,NBSH,IELE,MELE,NPINT,IPT2,IRT1)
          ENDIF
          IF (IERR.NE.0) RETURN
C
          IF (IPT2.NE.0) CALL SAVSEG(IPT2)
          INTEGR(MELE,ITYPI,IBMODE) = IPT2
 19       CONTINUE
          IF (bstocke) IMODEL.INFMOD(2+ITYPI) = IPT2
C
 20     CONTINUE
C
C       XQ4R : calculer egalement les fcts de forme du QUA4
        IF (MELE.EQ.263) THEN
          IDETY = 5
          MELE  = 8
          NBSH  = 4
          NBG   = 4
          NBGM  = 4
          NBGST = 4
C       XC8R : calculer egalement les fcts de forme du CUB8
        ELSE IF (MELE.EQ.264) THEN
          IDETY = 5
          MELE  = 14
          NBSH  = 8
          NBG   = 8
          NBGM  = 8
          NBGST = 8
        ENDIF
C
      ENDIF
C     =================================================================
C     
      DO 10 ITYPI=IDEB,IFIN
C
C       Elements de THERMIQUE (non utilise)
        IF (MELE.GE.57.AND.MELE.LE.68) THEN
C         CALL TINTR(MELE,IPT1)
          GOTO 10
        ENDIF
C
C       Infos pour l'element MELE, mode de calcul IBMODE deja creees
        IPT1=INTEGR(MELE,ITYPI,IBMODE)
        IF (IPT1.NE.0) GOTO 9
C
C       ---------------------------------------------------------------
C       1 : Segment d'integration aux noeuds
C       ---------------------------------------------------------------
        IF (ITYPI.EQ.1) THEN
C         sg : uniquement les elements fluide en reshpt             
          IF (MELE.GE.195.AND.MELE.LE.257) THEN
            CALL RESHPT(NBG,NBSH,IELE,MELE,0,IPT1,IRT1)
          ELSE
            CALL RENOEU(IELE,MELE,NBSH,IPT1,IRT1)
          ENDIF
C       ---------------------------------------------------------------
C       2 : Segment d'integration au centre de gravite
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.2) THEN
          CALL RESHPT(1,NBSH,IELE,MELE,NPINT,IPT1,IRT1)
C       ---------------------------------------------------------------
C       3 : Segment d'integration pour la rigidite
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.3) THEN
          CALL RESHPT(NBG,NBSH,IELE,MELE,NPINT,IPT1,IRT1)
C       ---------------------------------------------------------------
C       4 : Segment d'integration pour la masse
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.4) THEN
          CALL RESHPT(NBGM,NBSH,IELE,MELE,NPINT,IPT1,IRT1)
C       ---------------------------------------------------------------
C       5 : Segment d'integration pour les contraintes
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.5) THEN
          IF (MELE.GE.195.AND.MELE.LE.257) THEN
            IPT1=0
          ELSE
            CALL RESHPT(NBGST,NBSH,IELE,MELE,NPINT,IPT1,IRT1)
          ENDIF
C       ---------------------------------------------------------------
C       6 : Pas de segment d'integration
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.6) THEN
          IPT1 = 0
C       ---------------------------------------------------------------
C       7 : Segment d'integration pour la rigidite autres pdg
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.7) THEN
          CALL RESHPT(NBG,NBSH,IELE,MELE,NPINT,IPT1,IRT1)
C       ---------------------------------------------------------------
C       8 : Segment d'integration CENTREP1 (Elements Navier Stokes)
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.8) THEN
C
C         Cas MACRO 2D QUAF 2D --> TRI3
          IF (MELE.EQ.217.OR.MELE.EQ.224.OR.MELE.EQ.231
     &    .OR.MELE.EQ.238.OR.MELE.EQ.245.OR.MELE.EQ.252) NBSH = 3
C         Cas MACRO 2D QUAF 2D --> QUA4
          IF (MELE.EQ.218.OR.MELE.EQ.225.OR.MELE.EQ.232
     &    .OR.MELE.EQ.239.OR.MELE.EQ.246.OR.MELE.EQ.253) NBSH = 3
C         Cas MACRO 3D QUAF 3D
C         IF ((MELE.GE.226.AND.MELE.LE.229).OR.
C     &       (MELE.GE.247.AND.MELE.LE.250)) NBSH = 4
          CALL RESHPT(NBG,NBSH,IELE,MELE,1,IPT1,IRT1)
C       ---------------------------------------------------------------
C       9 : Segment d'integration MSOMMET (Elements Navier Stokes)
C       ---------------------------------------------------------------
        ELSE IF (ITYPI.EQ.9) THEN
C
C         Cas MACRO QUAF 1D --> SEG2
          IF (MELE.EQ.216.OR.MELE.EQ.223.OR.MELE.EQ.230
     &    .OR.MELE.EQ.237.OR.MELE.EQ.244.OR.MELE.EQ.251) IELE = 2
C         Cas MACRO QUAF 2D --> TRI3
          IF (MELE.EQ.217.OR.MELE.EQ.224.OR.MELE.EQ.231
     &    .OR.MELE.EQ.238.OR.MELE.EQ.245.OR.MELE.EQ.252) IELE = 4
C         Cas MACRO QUAF 2D --> QUA4
          IF (MELE.EQ.218.OR.MELE.EQ.225.OR.MELE.EQ.232
     &    .OR.MELE.EQ.239.OR.MELE.EQ.246.OR.MELE.EQ.253) IELE = 8
C         Cas MACRO QUAF 3D --> CUB8
          IF (MELE.EQ.233.OR.MELE.EQ.254) IELE = 14
C         Cas MACRO QUAF 3D --> PRI6
          IF (MELE.EQ.234.OR.MELE.EQ.255) IELE = 16
C         Cas MACRO QUAF 3D --> TET4
          IF (MELE.EQ.235.OR.MELE.EQ.256) IELE = 23
C         Cas MACRO QUAF 3D --> PYR5
          IF (MELE.EQ.236.OR.MELE.EQ.257) IELE = 25
          NBSH = NBNNE(IELE)
C
          CALL RESHPT(NBG,NBSH,IELE,MELE,2,IPT1,IRT1)
        ENDIF
        IF (IERR.NE.0) RETURN
C
        IF (IPT1.NE.0) CALL SAVSEG(IPT1)
        INTEGR(MELE,ITYPI,IBMODE) = IPT1
  9     CONTINUE
        IF (bstocke) IMODEL.INFMOD(2+ITYPI+IDETY) = IPT1
C
 10   CONTINUE
C
      MINTE=IPT1
      IF(MINTE.GT.0) SEGACT,MINTE
      IPTR=IPT1
 
      END