Sources Esope | Cast3M

sigele
C SIGELE    SOURCE    OF166741  25/02/21    21:18:33     12166          
 
      SUBROUTINE SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT1,NDEP,IVADEP,
     &                   LPERM,LRE,MATE,IVAMAT,NVMAT, IVASTR)
 
*----------------------------------------------------------------------*
*   CALCUL DES INDUCTIONS ELECTRIQUES (FORMULATION 'ELECTROSTATIQUE')  *
*----------------------------------------------------------------------*
*   ENTREES :                                                          *
*   ________                                                           *
*        MELE     Numero de l'element fini                             *
*        IPMAIL   Pointeur sur un segment  MELEME                      *
*        IPMINT1  Pointeur sur un segment MINTE                        *
*        NBPGAU   Nombre de point d'integration pour la rigidite       *
*        MATE     Numero du materiau                                   *
*        IVAMAT   Pointeur sur un segment MPTVAL pour le materiau ou   *
*        NVMAT    Nombre de composantes de materiau                    *
*                                                                      *
*   SORTIES :                                                          *
*   ________                                                           *
*        IVASTR   Pointeur sur                                         *
*----------------------------------------------------------------------*
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMCOORD
-INC SMELEME
-INC SMINTE
 
-INC TMPTVAL
 
      SEGMENT MWKELT
        REAL*8 DPERM(LPERM,LPERM),BGRELE(LPERM,LRE)
        REAL*8 XEL(3,NBNN),SHP(6,NBNN)
        REAL*8 VALMAT(NVMAT)
      ENDSEGMENT
 
      SEGMENT MWKMAT
        REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM)
        REAL*8 DPERM1(LPERM,LPERM)
      ENDSEGMENT
 
      SEGMENT MWKELE
        REAL*8 DDLELE(LRE),FLUELE(LPERM)
      ENDSEGMENT
 
      MINTE = IPMINT1
      MELEME = IPMAIL
      NBNN   = NUM(/1)
      NBELEM = NUM(/2)
 
      SEGINI,MWKELT
      IWKELT = MWKELT
 
      MWKMAT = 0
      IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
        CALL RESHPT(1,NBNN,IELE,MELE,0,IPMINT2,IRT1)
        MINTE2 = IPMINT2
        SEGACT,MINTE2
        NBSH = MINTE2.SHPTOT(/2)
        SEGINI,MWKMAT
      ENDIF
      IWKMAT = MWKMAT
 
      SEGINI,MWKELE
 
C-------------------------
C Boucle sur les elements
C-------------------------
      DO IEL = 1,NBELEM
C - Recuperation des coordonnees des noeuds de l element IEL
        CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
C - Calcul des axes locaux dans les cas orthotrope et anisotrope
        IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
          CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR)
          IF (NBSH.EQ.-1) THEN
            CALL ERREUR(525)
            GOTO 999
          ENDIF
        ENDIF
C - Recuperation des potentiels electriques aux noeuds de l element IEL
        MPTVAL = IVADEP
        IE = 1
        DO IGAU = 1, NBNN
          DO ICOMP = 1, NDEP
            MELVAL = IVAL(ICOMP)
            IGMN = MIN(IGAU,VELCHE(/1))
            IEMN = MIN(IEL ,VELCHE(/2))
            DDLELE(IE) = VELCHE(IGMN,IEMN)
            IE = IE+1
          ENDDO
        ENDDO
C--  --  --  --  --  --  --  --  --
C - Boucle sur les points de Gauss
C--  --  --  --  --  --  --  --  --
        ISDJC = 0
        DO IGAU = 1, NBPGAU
C -- Calcul de la matrice Bel et du jacobien au point de Gauss IGAU
          CALL BELEC(XEL,SHPTOT(1,1,IGAU),NBNN,LPERM,-1,
     &               SHP,BGRELE,DJAC)
          IF (DJAC.LT.0.) ISDJC = ISDJC+1
          IF (DJAC.EQ.0.) THEN
            INTERR(1) = IEL
            CALL ERREUR(259)
            GOTO 999
          ENDIF
C -- Recuperation des proprietes materielles (IGAU)
          MPTVAL = IVAMAT
          DO i = 1, NVMAT
            MELVAL = IVAL(i)
            IEMN = MIN(IEL ,VELCHE(/2))
            IGMN = MIN(IGAU,VELCHE(/1))
            VALMAT(i) = VELCHE(IGMN,IEMN)
          ENDDO
C -- Calcul de la matrice de permittivite dielectrique (IGAU)
          CALL PERMEL(MATE,IDIM, IWKELT,IWKMAT)
C -- Calcul de l'induction electrique Del (IGAU)
          CALL DBST(BGRELE,DPERM,DDLELE,LRE,LPERM,FLUELE)
C -- Remplissage du segment contenant Del = "contraintes"
          MPTVAL = IVASTR
          DO ICOMP = 1, LPERM
            MELVAL = IVAL(ICOMP)
            IEMN = MIN(IEL,VELCHE(/2))
            VELCHE(IGAU,IEMN) = FLUELE(ICOMP)
          ENDDO
C--  --  --  --  --  --  --  --  --
        ENDDO
C--  --  --  --  --  --  --  --  --
        IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN
          INTERR(1) = IEL
          CALL ERREUR(195)
          GOTO 999
        ENDIF
C-------------------------
      ENDDO
C-------------------------
 
 999  CONTINUE
      IF (MATE.EQ.2.OR.MATE.EQ.3) THEN
       SEGDES,MINTE2
       SEGSUP,MWKMAT
      ENDIF
      SEGSUP,MWKELT
      SEGSUP,MWKELE
 
      RETURN
      END