Sources Esope | Cast3M

cneqel
C CNEQEL    SOURCE    FANDEUR   10/12/17    21:16:08     6427
 
      SUBROUTINE CNEQEL (IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP)
 
*----------------------------------------------------------------------*
*     CALCUL DES FLUX EXLECTRIQUES ("FORCES") NODAUX EQUIVALENTS       *
*----------------------------------------------------------------------*
*   ENTREES :                                                          *
*   ________                                                           *
*        IPMAIL   Pointeur sur un segment  MELEME                      *
*        NBPGAU   Nombre de points d'integration pour les contraintes  *
*        IVAFVO   pointeur sur un segment MPTVAL contenant les         *
*                 les melvals de FORCES VOLUMIQUES                     *
*        IPMINT   Pointeur sur un segment MINTE                        *
*        IVACAR   Pointeur sur un melval de caractéristiques           *
*        NCOMP    Nombre de composantes de forces                      *
*                                                                      *
*   SORTIES :                                                          *
*   ________                                                           *
*                                                                      *
*        IVAFOR   pointeur sur un segment MPTVAL contenant les         *
*                 les melvals de forces NODALES                        *
*----------------------------------------------------------------------*
 
      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 MWKELT
        REAL*8 XFORC(NBNN),FOVOL(NCOMP),XEL(3,NBNN)
        REAL*8 SHPWRK(6,NBNN),XFORM(NBNN)
      ENDSEGMENT
 
      SEGMENT MPTVAL
        INTEGER IPOS(NS) , NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
 
      MELEME=IPMAIL
      NBNN  =NUM(/1)
      NBELEM=NUM(/2)
 
      MINTE=IPMINT
 
      SEGINI,MWKELT
 
      DO 3004 IEL = 1, NBELEM
 
C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IEL
        CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
 
C     MISE A ZERO DES FORCES NODALES
        DO j = 1, NBNN
          XFORC(j) = XZERO
        ENDDO
C
C     ON RECUPERE LES FORCES VOLUMIQUES
C
        MPTVAL = IVAFVO
        IF (IVAL(1).NE.0) THEN
          MELVAL = IVAL(1)
          IEMN = MIN(IEL ,VELCHE(/2))
 
C     BOUCLE SUR LES POINTS DE GAUSS
          ISDJC=0
          DO 5004 IGAU=1,NBPGAU
 
            CALL NELEC (NBNN,XEL,SHPTOT(1,1,IGAU), SHPWRK,XFORM,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)
*
*     CALCUL DES FORCES NODALES EQUIVALENTES
*
            IGMN = MIN(IGAU,VELCHE(/1))
            FOVOL(1) = VELCHE(IGMN,IEMN)
            r_z = FOVOL(1)*DJAC
            DO j = 1, NBNN
              XFORC(j) = XFORC(j) + XFORM(j)*r_z
            ENDDO
*
 5004     CONTINUE
*
          IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
            INTERR(1) = IEL
            CALL ERREUR(195)
            GOTO 999
          ENDIF
C
        ENDIF
C
C     ON RANGE XFORC DANS IVAFOR
C
        MPTVAL=IVAFOR
        MELVAL=IVAL(1)
        DO j = 1, NBNN
          VELCHE(j,IEL) = XFORC(j)
        ENDDO
 3004 CONTINUE
 
 999  CONTINUE
      SEGSUP,MWKELT
 
      RETURN
      END