Sources Esope | Cast3M

bsigdi
C BSIGDI    SOURCE    OF166741  23/06/30    21:15:03     11695          
 
      SUBROUTINE BSIGDI (IPMAIL,IPMINT,NBPGAU,IVASTR,NSTRS,LRE,LDIFF,
     &                   IVAFOR,NFOR)
 
*----------------------------------------------------------------------*
*       CALCUL DES FLUX DE DIFFUSION NODAUX EQUIVALENTS                *
*       Formulation 'DIFFUSION' (MFR=73) - Elements MASSIFs            *
*----------------------------------------------------------------------*
*  IPMAIL  (E)  Pointeur sur un segment  MELEME (ACTIF)                *
*  IPMINT  (E)  Pointeur sur un segment MINTE (ACTIF)                  *
*  NBPGAU  (E)  Nombre de points d'integration pour les "contraintes"  *
*  IVASTR  (E)  pointeur sur un segment MPTVAL contenant les           *
*               melvals de contraintes                                 *
*  NSTRS   (E)  Nombre de composantes de "contraintes/deformations"    *
*  LRE     (E)  Nombre de DDL dans la matrice de "rigidite"            *
*  LDIFF   (E)  Nombre de composantes de "deformations" = NSTRS        *
*  IVAFOR  (E)  pointeur sur un segment MPTVAL contenant les           *
*               melvals de forces                                      *
*  NFOR    (E)  Nombre de composantes de "flux" LRE = NBNN * NFOR      *
*----------------------------------------------------------------------*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMELEME
-INC SMCOORD
-INC SMINTE
 
      SEGMENT MWRK1
        REAL*8 XFORC(LRE), XFLUD(NSTRS), XEL(3,NBNN)
        REAL*8 SHP(6,NBNN), BGRDIF(LDIFF,LRE)
      ENDSEGMENT
 
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
 
      MELEME = IPMAIL
      NBNN   = meleme.NUM(/1)
      NBELEM = meleme.NUM(/2)
 
      MINTE = IPMINT
**      NBPGAU = minte.POIGAU(/1)
 
      SEGINI,MWRK1
 
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 - Initialisation des flux nodaux equivalents
        DO ICOMP = 1, LRE
          XFORC(ICOMP) = XZero
        ENDDO
C
        MPTVAL = IVASTR
C--  --  --  --  --  --  --  --  --
C - Boucle sur les points de Gauss
C--  --  --  --  --  --  --  --  --
        ISDJC = 0
        DO IGAU = 1, NBPGAU
C -- Calcul de la matrice Bdif et du jacobien au point de Gauss IGAU
          CALL BDIFF(XEL,SHPTOT(1,1,IGAU),NBNN,LDIFF,1,
     &               SHP,BGRDIF,DJAC)
          IF (DJAC.EQ.XZero) THEN
            INTERR(1) = IEL
            CALL ERREUR(259)
            GOTO 999
          ENDIF
          IF (DJAC.LT.XZero) ISDJC = ISDJC+1
          DJAC = ABS(DJAC)*POIGAU(IGAU)
C -- Recuperation des flux au point d'integration (IGAU)
          DO ICOMP = 1, NSTRS
            MELVAL = IVAL(ICOMP)
            IGMN = MIN(IGAU,VELCHE(/1))
            IEMN = MIN(IEL ,VELCHE(/2))
            XFLUD(ICOMP) = VELCHE(IGMN,IEMN)
          ENDDO
C -- Calcul du terme Bdif * Flux et de la contribution du point IGAU
          DO ICOMP = 1, LRE
            r_z = XZero
            DO JCOMP = 1, NSTRS
              r_z = r_z + BGRDIF(JCOMP,ICOMP) * XFLUD(JCOMP)
            ENDDO
            XFORC(ICOMP) = XFORC(ICOMP) + r_z*DJAC
          ENDDO
C--  --  --  --  --  --  --  --  --
        ENDDO
C--  --  --  --  --  --  --  --  --
        IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
          INTERR(1) = IEL
          CALL ERREUR(195)
          GOTO 999
        ENDIF
C - Stockage de XFORC dans le MELVAL IVAFOR
        MPTVAL = IVAFOR
        IE = 0
        DO IGAU = 1, NBNN
          DO ICOMP = 1, NFOR
            IE = IE + 1
            MELVAL = IVAL(ICOMP)
            IEMN = MIN(IEL,VELCHE(/2))
            VELCHE(IGAU,IEMN) = XFORC(IE)
          ENDDO
        ENDDO
C-------------------------
      ENDDO
C-------------------------
 
 999  CONTINUE
      SEGSUP,MWRK1
 
      RETURN
      END