Télécharger la plaquette Cast3M


fr en

Télécharger cneqmg.eso

Retour à la liste

Numérotation des lignes : 

cneqmg

  1. C CNEQMG    SOURCE    OF166741  25/02/21    21:15:36     12166          
  2.       SUBROUTINE CNEQMG(IPMAIL,IPMINT,IVAPVE,IVAPNO,MOFOVO,MELE)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. *                             C N E Q M G
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *     CALCUL DU PRODUIT DU POTENTIEL VECTEUR INDUCTEUR
  13. *     AVEC LES FONCTIONS DE FORME ROT3 POUR LA
  14. *     FORMULATION MAGNETODYNAMIQUE
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC CCHAMP
  23. -INC CCREEL
  24.  
  25. -INC SMCOORD
  26. -INC SMINTE
  27. -INC SMMODEL
  28. -INC SMELEME
  29. -INC SMCHAML
  30. *
  31. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  32. * -----------
  33. *
  34. *     IPMAIL  (E)  NUMERO DU MAILLAGE ELEMENTAIRE CONSIDERE  (ACTIF E/S)
  35. *     IPMINT  (E)  POINTEUR SUR UN SEGMENT MINTE             (ACTIF E/S)
  36. *     IVAPVE  (E)  POINTEUR SUR UN SEGMENT MPTVAL POUR LE POTENTIEL VECTEUR
  37. *     IVAPNO  (S)  POINTEUR SUR UN SEGMENT MPTVAL POUR LE RESULTAT
  38. *    +XCOOR   (E)  VOIR SMCOORD
  39. *    +IDIM    (E)  VOIR CCOPTIO
  40. *    +IFOMOD  (E)  VOIR CCOPTIO
  41. *    +XZERO   (E)  VOIR CCREEL
  42. *
  43. * VARIABLES:
  44. * ----------
  45. *
  46. *     NBNN     NOMBRE DE NOEUDS DANS L'ELEMENT CONSIDERE
  47. *     NEF      NUMERO DE L'ELEMENT FINI DANS NOMTP (VOIR CCHAMP)
  48. *     NBELEM   NOMBRE D'ELEMENTS DANS LE MAILLAGE ELEMENTAIRE
  49. *     NBPGAU   NOMBRE DE POINTS DE GAUSS DANS L'ELEMENT-FINI
  50. *     NDIM     NOMBRE DE LIGNES DE LA MATRICE GRADIENT
  51. *     XE(3,NBNN)      COORDONNEES DE L'ELEMENT DANS LE REPERE GLOBAL
  52. *     SHP(6,NBNN)     TABLEAU DE TRAVAIL
  53. *     VALMAT(NMATR)  TABLEAU DE TRAVAIL
  54.  
  55. -INC TMPTVAL
  56.  
  57.       SEGMENT,MMAT1
  58.          REAL*8 VALMAT(NMATR)
  59.          REAL*8 XE(3,NBNN),XE1(3,NBNN)
  60.          REAL*8 SHP(6,NBNN)
  61.          REAL*8 COSD1(3),COSD2(3),GRD3(3,3)
  62.       ENDSEGMENT
  63. *
  64.       SEGMENT NOTYPE
  65.         CHARACTER*16 TYPE(NBTYPE)
  66.       ENDSEGMENT
  67. *
  68.       CHARACTER*8 CNM
  69.       CHARACTER*(NCONCH) CONM
  70. *
  71. * AUTEUR, DATE DE CREATION:
  72. * -------------------------
  73. *
  74. *     YANN STEPHAN , AOUT 1997 (COPIE DE ROT3R)
  75. *
  76. * LANGAGE:
  77. * --------
  78. *
  79. *     ESOPE + FORTRAN77
  80. *
  81. ************************************************************************
  82. *
  83. *     RECUPERATION DES CARACTERISTIQUES GEOMETRIQUES DU MAILLAGE
  84. *     ELEMENTAIRE
  85. *
  86.       MELEME=IPMAIL
  87. C*    SEGACT,MELEME                    <- Actif en E/S
  88.       NBNN=NUM(/1)
  89.       NBELEM=NUM(/2)
  90. *
  91. *     RECUPERATION DES CARACTERISTIQUES D'INTEGRATION DE L'ELEMENT
  92. *     FINI LIE A NOTRE MAILLAGE
  93. *
  94.       MINTE=IPMINT
  95. C*    SEGACT,MINTE                     <- Actif en E/S
  96.       NBPGAU=POIGAU(/1)
  97. *
  98. *     CHANGEMENT DE SUPPORT DU MPTVAL IVAPVE
  99. *
  100.       MPTVAL=IVAPVE
  101.       NCOMP=IVAL(/1)
  102. *
  103. * on suppose pas de formulation poreux ici
  104.       IPPORE=0
  105. *
  106.       CALL VALCHE(IVAPVE,NCOMP,IPMINT,IPPORE,MOFOVO,MELE)
  107. *
  108.       NDIM=IDIM-1
  109.       NFIN=NDIM+1
  110.       NMATR=NCOMP
  111.       SEGINI,MMAT1
  112. *
  113. *     BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAIL
  114. *
  115.       DO 10 IEL=1,NBELEM
  116. *
  117. *        MISE A ZERO DU TABLEAU XE1
  118. *
  119.          CALL ZERO (XE1,3,NBNN)
  120. *
  121. *        ON CHERCHE LES COORDONNEES DES NOEUDS DE L'ELEMENT IEL,
  122. *        DANS LE REPERE GLOBAL
  123. *
  124.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  125. *
  126. *        CALCUL DES COORDONNEES DES NOEUDS DANS LE REPERE LOCAL DE L'
  127. *        ELEMENT COQUE
  128. *
  129.          CALL COQLOC(NBNN,XE,COSD1,COSD2,XE1)
  130. *
  131.          IFOIS=0
  132.          IFOI2=0
  133.          DO 20 IGAU=1,NBPGAU
  134. *
  135. *        CALCUL DE LA MATRCIE GRADIENT DES FONCTIONS DE FORME ET
  136. *        DU JACOBIEN(DANS LE PLAN), EN UN POINT DE GAUSS
  137. *
  138.          DO 90 NP=1,NBNN
  139.          DO 90  I=1,NFIN
  140.          SHP(I,NP)=SHPTOT(I,NP,IGAU)
  141.   90     CONTINUE
  142. *
  143. *        DERIVES DES FONCTIONS DE FORME DANS LA GEOMETRIE REELLE
  144. *        ET LE JACOBIEN
  145.          CALL JACOBI(XE1,SHP,NDIM,NBNN,DJAC)
  146. *
  147.          IF(DJAC.LT.XZERO)IFOIS=IFOIS+1
  148.          IF(ABS(DJAC).LT.XPETIT)IFOI2=IFOI2 +1
  149. *
  150.          DO 100 NP=1,NBNN
  151. *          ON FAIT TOURNER LE GRADIENT DE -PI/2 DANS LE REPERE LOCAL
  152. *          POUR ETRE PARALLELE AU COTE OPPOSE AU SOMMET
  153.            XG=SHP(2,NP)
  154.            SHP(2,NP)=SHP(3,NP)
  155. C*         YG=SHP(3,NP)
  156. C*         SHP(2,NP)=YG
  157.            SHP(3,NP)=-XG
  158. *        RETOUR AU REPERE 3D
  159.            r_z1 = SHP(2,NP)
  160.            r_z2 = SHP(3,NP)
  161.            DO 60 I=1,NFIN
  162.              GRD3(I,NP)= r_z1*COSD1(I) + r_z2*COSD2(I)
  163.    60      CONTINUE
  164.   100    CONTINUE
  165. *
  166. *        ON MULTIPLIE LE JACOBIEN PAR LE POIDS D'INTEGRATION,POUR LE
  167. *        POINT DE GAUSS CONSIDERE
  168. *
  169.          DJAC=ABS(DJAC)*POIGAU(IGAU)
  170. *
  171. *        ON CHERCHE LES VALEURS DES COMPOSANTES
  172. *        DU POTENTIEL VECTEUR
  173. *
  174.          MPTVAL=IVAPVE
  175.          DO  30 IM=1,NCOMP
  176.          IF(IVAL(IM).NE.0)THEN
  177.            MELVAL=IVAL(IM)
  178.            IBMN=MIN(IEL,VELCHE(/2))
  179.            IGMN=MIN(IGAU,VELCHE(/1))
  180.            VALMAT(IM)=VELCHE(IGMN,IBMN)
  181.          ELSE
  182.            VALMAT(IM)=0.
  183.          ENDIF
  184.    30    CONTINUE
  185. *
  186. *        ON EFFECTUE LE PRODUIT DJAC*TRANSPOSEE(GRAD)*VALMAT
  187. *        POUR LE POINT DE GAUSS CONSIDERE (RESULTAT SCALAIRE)
  188. *
  189.          MPTVAL=IVAPNO
  190.          MELVAL=IVAL(1)
  191.          DO 40 IP=1,NBNN
  192.            r_z = 0.
  193.            DO 41 IM=1,NCOMP
  194.              r_z = r_z + GRD3(IM,IP)*VALMAT(IM)
  195.    41      CONTINUE
  196.            VELCHE(IP,IEL)=VELCHE(IP,IEL) + DJAC*r_z
  197.    40    CONTINUE
  198. *
  199.   20  CONTINUE
  200. *
  201. *   LE JACOBIEN EST NEGATIF ,MAILLAGE INCORRECT
  202.        IF(IFOIS.NE.0.AND.IFOIS.NE.NBPGAU)THEN
  203.         INTERR(1)=IEL
  204.         CALL ERREUR(195)
  205.         GO TO 999
  206. *
  207. *   CAS OU LE JACOBIEN EST TRES PETIT
  208.        ELSEIF(IFOI2.EQ.NBPGAU)THEN
  209.         INTERR(1)=IEL
  210.         CALL ERREUR (259)
  211.         GO TO 999
  212.        ENDIF
  213. *
  214.  10   CONTINUE
  215. *
  216. *     DESACTIVATION DES SEGMENTS
  217. *
  218.  999  CONTINUE
  219.       SEGSUP,MMAT1
  220.       END
  221.  
  222.  
  223.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales