C CNEQEL    SOURCE    OF166741  25/02/21    21:15:34     12166          

      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

-INC TMPTVAL

      SEGMENT MWKELT
        REAL*8 XFORC(NBNN),FOVOL(NCOMP),XEL(3,NBNN)
        REAL*8 SHPWRK(6,NBNN),XFORM(NBNN)
      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
        MELVAL = IVAL(1)
        IF (MELVAL.NE.0) THEN
          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