Télécharger cneqmg.eso

Retour à la liste

Numérotation des lignes :

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

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