Sources Esope | Cast3M

idvec2
C IDVEC2    SOURCE    OF166741  26/06/04    21:15:21     12563          
 
*----------------------------------------------------------------------*
*     Recherche des noms de composantes pour creer des vecteurs        *
*     a partir de MCHAML (appele par vecte2 ou vecte3)                 *
*     ICAS = 1 : cas des contraintes principales                       *
*     ICAS = 2 : cas des fissures                                      *
*----------------------------------------------------------------------*
      SUBROUTINE IDVEC2(ICAS,NDIM,MFR,CMOT,IF3,IPNOMC,NBROBL,NLIST,IER1)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
C==DEB= FORMULATION HHO == Include specifique ==========================
-INC CCHHOPA
C==FIN= FORMULATION HHO ================================================
 
-INC SMMODEL
 
      DIMENSION IPNOMC(*)
      CHARACTER*(*) CMOT
 
      CHARACTER*(4) CMO4
 
      IER1 = 0
 
      IPNOMC(1) = 0
      IPNOMC(2) = 0
      IPNOMC(3) = 0
 
      CMO4 = CMOT(1:4)
 
      IMO = 0
      IF (CMO4.NE.'    ') IMO = 1
 
*   Contraintes/Deformations principales
*   ------------------------------------
      IF (ICAS.EQ.1) THEN
 
        IF3 = 0
 
        IF (MFR.EQ.3 .OR. MFR.EQ.5 .OR. MFR.EQ.9) THEN
          IF (IMO.EQ.1) THEN
            IF (CMO4.NE.'SI11'.AND.CMO4.NE.'SI22') THEN
              IER1 = 2
              GOTO 900
            ENDIF
          ENDIF
          NLIST = 2
 
          NBROBL = 4
          NBRFAC = 0
          SEGINI NOMID
          LESOBL(1) = 'SI11'
          LESOBL(2) = 'COX1'
          LESOBL(3) = 'COY1'
          LESOBL(4) = 'COZ1'
          IPNOMC(1) = NOMID
 
          NBROBL = 4
          NBRFAC = 0
          SEGINI NOMID
          LESOBL(1) = 'SI22'
          LESOBL(2) = 'COX2'
          LESOBL(3) = 'COY2'
          LESOBL(4) = 'COZ2'
          IPNOMC(2) = NOMID
 
        ELSE IF (MFR.EQ. 1 .OR. MFR.EQ.31 .OR.
     &           MFR.EQ.63 .OR. MFR.EQ.52 .OR.
     &           MFR.EQ.HHO_MFR_ELEMENT) THEN
          IF (NDIM.EQ.2) THEN
            IF (IMO.EQ.1) THEN
              IF (CMO4.NE.'SI11'.AND.CMO4.NE.'SI22') THEN
                IER1 = 2
                GOTO 900
              ENDIF
            ENDIF
            NLIST = 2
 
            NBROBL = 4
            NBRFAC = 0
            SEGINI NOMID
            LESOBL(1) = 'SI11'
            LESOBL(2) = 'COX1'
            LESOBL(3) = 'COY1'
            LESOBL(4) = 'COZ1'
            IPNOMC(1) = NOMID
 
            NBROBL = 4
            NBRFAC = 0
            SEGINI NOMID
            LESOBL(1) = 'SI22'
            LESOBL(2) = 'COX2'
            LESOBL(3) = 'COY2'
            LESOBL(4) = 'COZ2'
            IPNOMC(2) = NOMID
 
          ELSE IF (NDIM.EQ.3) THEN
            IF (IMO.EQ.1) THEN
              IF (CMO4.NE.'SI11'.AND.CMO4.NE.'SI22'
     &                          .AND.CMO4.NE.'SI33') THEN
                IER1 = 2
                GOTO 900
              ENDIF
            ENDIF
            NLIST = 3
 
            NBROBL = 4
            NBRFAC = 0
            SEGINI NOMID
            LESOBL(1) = 'SI11'
            LESOBL(2) = 'COX1'
            LESOBL(3) = 'COY1'
            LESOBL(4) = 'COZ1'
            IPNOMC(1) = NOMID
 
            NBROBL = 4
            NBRFAC = 0
            SEGINI NOMID
            LESOBL(1) = 'SI22'
            LESOBL(2) = 'COX2'
            LESOBL(3) = 'COY2'
            LESOBL(4) = 'COZ2'
            IPNOMC(2) = NOMID
 
            NBROBL = 4
            NBRFAC = 0
            SEGINI NOMID
            LESOBL(1) = 'SI33'
            LESOBL(2) = 'COX3'
            LESOBL(3) = 'COY3'
            LESOBL(4) = 'COZ3'
            IPNOMC(3) = NOMID
 
          ELSE
            IER1 = 1
          ENDIF
        ELSE
          IER1 = 1
        ENDIF
 
*   Fissures
*   --------
      ELSE IF (ICAS.EQ.2) THEN
 
        IF3 = 0
*   En 3D / IF3=1 : coques / IF3=2 : massifs
        IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
          IF3 = 1
        ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
          IF (IDIM.EQ.3) IF3 = 2
          IF (IDIM.EQ.2) IF3 = 3
        ENDIF
        IF (IF3.EQ.0) THEN
          call erreur(19)
          GOTO 900
        ENDIF
 
        IF (NDIM.EQ.2) THEN
          NLIST = 2
 
          NBROBL = 2
          NBRFAC = 0
          SEGINI NOMID
          LESOBL(1) = 'VF1X'
          LESOBL(2) = 'VF1Y'
          IPNOMC(1) = NOMID
 
          NBROBL = 2
          NBRFAC = 0
          SEGINI NOMID
          LESOBL(1) = 'VF2X'
          LESOBL(2) = 'VF2Y'
          IPNOMC(2) = NOMID
 
        ELSE IF (NDIM.EQ.3) THEN
          NLIST = 2
          IF (IF3.EQ.2) NLIST = 3
 
          NBROBL = 2
          IF (IF3.EQ.2)  NBROBL = 3
          NBRFAC = 0
          SEGINI NOMID
          LESOBL(1) = 'VF1X'
          LESOBL(2) = 'VF1Y'
          IF (IF3.EQ.2) LESOBL(3) = 'VF1Z'
          IPNOMC(1) = NOMID
 
          NBROBL = 2
          IF (IF3.EQ.2)  NBROBL = 3
          NBRFAC = 0
          SEGINI NOMID
          LESOBL(1) = 'VF2X'
          LESOBL(2) = 'VF2Y'
          IF (IF3.EQ.2) LESOBL(3) = 'VF2Z'
          IPNOMC(2) = NOMID
 
          IF (IF3.EQ.2) THEN
            NBROBL = 3
            NBRFAC = 0
            SEGINI NOMID
            LESOBL(1) = 'VF3X'
            LESOBL(2) = 'VF3Y'
            LESOBL(3) = 'VF3Z'
            IPNOMC(3) = NOMID
          ENDIF
 
        ENDIF
 
* Cas non prevu
      ELSE
        IER1 = 1
      ENDIF
 
* Gestion des erreurs
 900  CONTINUE
      IF (IER1.EQ.1) THEN
        moterr(1:8) = 'MFR=    '
        write(moterr(5:6),FMT='(I2)') MFR
        call erreur(193)
      ELSE IF (IER1.EQ.2) THEN
        moterr(1:4) = CMO4
        call erreur(197)
      ENDIF
 
c      RETURN
      END