Sources Esope | Cast3M

cneqmg
C CNEQMG    SOURCE    CB215821  24/04/12    21:15:18     11897          
      SUBROUTINE CNEQMG(IPMAIL,IPMINT,IVAPVE,IVAPNO,MOFOVO,MELE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
************************************************************************
*
*                             C N E Q M G
*                             -----------
*
* FONCTION:
* ---------
*     CALCUL DU PRODUIT DU POTENTIEL VECTEUR INDUCTEUR
*     AVEC LES FONCTIONS DE FORME ROT3 POUR LA
*     FORMULATION MAGNETODYNAMIQUE
*
* MODULES UTILISES:
* -----------------
*
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCOORD
-INC SMINTE
-INC CCHAMP
-INC SMMODEL
-INC SMELEME
-INC SMCHAML
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     IPMAIL  (E)  NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE  (ACTIF E/S)
*     IPMINT  (E)  POINTEUR SUR UN SEGMENT MINTE             (ACTIF E/S)
*     IVAPVE  (E)  POINTEUR SUR UN SEGMENT MPTVAL POUR LE POTENTIEL VECTEUR
*     IVAPNO  (S)  POINTEUR SUR UN SEGMENT MPTVAL POUR LE RESULTAT
*    +XCOOR   (E)  VOIR SMCOORD
*    +IDIM    (E)  VOIR CCOPTIO
*    +IFOMOD  (E)  VOIR CCOPTIO
*    +XZERO   (E)  VOIR CCREEL
*
* VARIABLES:
* ----------
*
*     NBNN     NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE
*     NEF      NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP)
*     NBELEM   NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE
*     NBPGAU   NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI
*     NDIM     NOMBRE DE LIGNES DE LA MATRICE GRADIENT
*     XE(3,NBNN)      COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL
*     SHP(6,NBNN)     TABLEAU DE TRAVAIL
*     VALMAT(NMATR)  TABLEAU DE TRAVAIL
*
      SEGMENT,MMAT1
         REAL*8 VALMAT(NMATR)
         REAL*8 XE(3,NBNN),XE1(3,NBNN)
         REAL*8 SHP(6,NBNN)
         REAL*8 COSD1(3),COSD2(3),GRD3(3,3)
      ENDSEGMENT
*
      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT
*
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
*
      CHARACTER*8 CNM
      CHARACTER*(NCONCH) CONM
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     YANN STEPHAN , AOUT 1997 (COPIE DE ROT3R)
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
*     RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE
*     ELEMENTAIRE
*
      MELEME=IPMAIL
C*    SEGACT,MELEME                    &lt;- Actif en E/S
      NBNN=NUM(/1)
      NBELEM=NUM(/2)
*
*     RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT
*     FINI LIE A NOTRE MAILLAGE
*
      MINTE=IPMINT
C*    SEGACT,MINTE                     &lt;- Actif en E/S
      NBPGAU=POIGAU(/1)
*
*     CHANGEMENT DE SUPPORT DU MPTVAL IVAPVE
*
      MPTVAL=IVAPVE
      NCOMP=IVAL(/1)
*
* on suppose pas de formulation poreux ici
      IPPORE=0
*
      CALL VALCHE(IVAPVE,NCOMP,IPMINT,IPPORE,MOFOVO,MELE)
*
      NDIM=IDIM-1
      NFIN=NDIM+1
      NMATR=NCOMP
      SEGINI,MMAT1
*
*     BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
*
      DO 10 IEL=1,NBELEM
*
*        MISE A ZERO DU TABLEAU XE1
*
         CALL ZERO (XE1,3,NBNN)
*
*        ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL,
*        DANS LE REPERE GLOBAL
*
         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
*
*        CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
*        ELEMENT COQUE
*
         CALL COQLOC(NBNN,XE,COSD1,COSD2,XE1)
*
         IFOIS=0
         IFOI2=0
         DO 20 IGAU=1,NBPGAU
*
*        CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET
*        DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS
*
         DO 90 NP=1,NBNN
         DO 90  I=1,NFIN
         SHP(I,NP)=SHPTOT(I,NP,IGAU)
  90     CONTINUE
*
*        DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE
*        ET LE JACOBIEN
         CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC)
*
         IF(DJAC.LT.XZERO)IFOIS=IFOIS+1
         IF(ABS(DJAC).LT.XPETIT)IFOI2=IFOI2 +1
*
         DO 100 NP=1,NBNN
*          ON FAIT TOURNER LE GRADIENT DE -PI/2 DANS LE REPERE LOCAL
*          POUR ETRE PARALLELE AU COTE OPPOSE AU SOMMET
           XG=SHP(2,NP)
           SHP(2,NP)=SHP(3,NP)
C*         YG=SHP(3,NP)
C*         SHP(2,NP)=YG
           SHP(3,NP)=-XG
*        RETOUR AU REPERE 3D
           r_z1 = SHP(2,NP)
           r_z2 = SHP(3,NP)
           DO 60 I=1,NFIN
             GRD3(I,NP)= r_z1*COSD1(I) + r_z2*COSD2(I)
   60      CONTINUE
  100    CONTINUE
*
*        ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE
*        POINT DE GAUSS CONSIDERE
*
         DJAC=ABS(DJAC)*POIGAU(IGAU)
*
*        ON CHERCHE LES VALEURS DES COMPOSANTES
*        DU POTENTIEL VECTEUR
*
         MPTVAL=IVAPVE
         DO  30 IM=1,NCOMP
         IF(IVAL(IM).NE.0)THEN
           MELVAL=IVAL(IM)
           IBMN=MIN(IEL,VELCHE(/2))
           IGMN=MIN(IGAU,VELCHE(/1))
           VALMAT(IM)=VELCHE(IGMN,IBMN)
         ELSE
           VALMAT(IM)=0.
         ENDIF
   30    CONTINUE
*
*        ON EFFECTUE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*VALMAT
*        POUR LE POINT DE GAUSS CONSIDERE (RESULTAT SCALAIRE)
*
         MPTVAL=IVAPNO
         MELVAL=IVAL(1)
         DO 40 IP=1,NBNN
           r_z = 0.
           DO 41 IM=1,NCOMP
             r_z = r_z + GRD3(IM,IP)*VALMAT(IM)
   41      CONTINUE
           VELCHE(IP,IEL)=VELCHE(IP,IEL) + DJAC*r_z
   40    CONTINUE
*
  20  CONTINUE
*
*   LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT
       IF(IFOIS.NE.0.AND.IFOIS.NE.NBPGAU)THEN
        INTERR(1)=IEL
        CALL ERREUR(195)
        GO TO 999
*
*   CAS OU LE JACOBIEN EST TRES PETIT
       ELSEIF(IFOI2.EQ.NBPGAU)THEN
        INTERR(1)=IEL
        CALL ERREUR (259)
        GO TO 999
       ENDIF
*
 10   CONTINUE
*
*     DESACTIVATION DES SEGMENTS
*
 999  CONTINUE
      SEGSUP,MMAT1
      END