Télécharger matpmv.eso

Retour à la liste

Numérotation des lignes :

matpmv
  1. C MATPMV SOURCE CB215821 23/11/02 21:15:06 11779
  2. SUBROUTINE MATPMV(IMAIL1,ILREE1,NBELEM,NBNN,XEPAIS)
  3.  
  4. * ---------------------------------------------------------------------
  5. *
  6. * ROUTINE MATPMV
  7. *
  8. * ---------------------------------------------------------------------
  9. * Auteur : Nikola JERANCE
  10. *
  11. * Historique :
  12. *
  13. * 20/09/2022 - Première écriture (N. Jerance)
  14. * 16/02/2023 on prend en compte l'épaisseur (N. Jerance)
  15. *
  16. * Descriptif :
  17. *
  18. * Calcul de la matrice qui exprime le potentiel vecteur magnétique
  19. * à partir de la densité de courant J. En entrée on a un maillage 2D
  20. * et en sortie on a une liste de rééls (qui est en fait une matrice M).
  21. * Pour calculer le potentiel vecteur par la suite, il faut multiplier M
  22. * par la densité de courant J. J(x,y) donne A(x,y) mais en 3D.
  23. *
  24. *
  25. *
  26. * Arguments :
  27. *
  28. * (E) IMAIL1 = Pointeur sur un MAILLAGE; actif en entrée et en sortie
  29. ** (S) ILREE1 = Pointeur sur la liste de réels (résultat); actif en sortie
  30. * (E) NBELEM = nombre d'éléments du maillage
  31. * (E) NBNN = nombre de noeuds par élément
  32. * (E) XEPAIS = épaisseur
  33. * ---------------------------------------------------------------------
  34.  
  35. * ----------------------------------------------------------------------
  36. *
  37. * 0 - DECLARATIONS ET IMPORTS
  38. *
  39. * ----------------------------------------------------------------------
  40.  
  41. IMPLICIT INTEGER(I-N)
  42. IMPLICIT REAL*8(A-H,O-Z)
  43.  
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC CCGEOME
  47. -INC CCREEL
  48. -INC SMCOORD
  49. -INC SMELEME
  50. -INC SMLREEL
  51.  
  52. POINTEUR ILREE1.MLREEL
  53. POINTEUR IMAIL1.MELEME
  54. INTEGER NBELEM,NBNN,NG
  55. DIMENSION XE(3,NBNN),A1(NBELEM,NBELEM),XCTR1(NBELEM),YCTR1(NBELEM)
  56. DIMENSION S(NBELEM),XP(NBNN),YP(NBNN),ALPHA1(NBNN)
  57. REAL*8 CG1(6), WG1(6)
  58. REAL*8 ZG1(36),ZG2(36),WG(36),R1(36)
  59.  
  60. NG = 6
  61. ZMIN =-0.5*XEPAIS
  62. ZMAX = 0.5*XEPAIS
  63. CG1(1) = 0.0338
  64. CG1(2) = 0.1694
  65. CG1(3) = 0.3807
  66. CG1(4) = 0.6193
  67. CG1(5) = 0.8306
  68. CG1(6) = 0.9662
  69.  
  70. WG1(1) = 0.0856
  71. WG1(2) = 0.1804
  72. WG1(3) = 0.234
  73. WG1(4) = 0.234
  74. WG1(5) = 0.1804
  75. WG1(6) = 0.0856
  76. DO I=1,NG
  77. ZG2(I) = CG1(I)*ZMIN + CG1(7-I)*ZMAX
  78. END DO
  79.  
  80. NBNN1 = NBNN - 1
  81. * WRITE(IOIMP,*) ' PARTIE 2 : CALCUL DE LA MATRICE'
  82.  
  83. SEGACT,MCOORD
  84. DO I = 1,NBELEM
  85.  
  86. CALL DOXE(XCOOR,IDIM,NBNN,IMAIL1.NUM,I,XE)
  87. XCTR1(I) = 0.0
  88. YCTR1(I) = 0.0
  89. S(I) = 0.0
  90. DO L=1,NBNN
  91. X1 = XE(1,L)
  92. Y1 = XE(2,L)
  93.  
  94. XCTR1(I) = XCTR1(I) + X1/NBNN
  95. YCTR1(I) = YCTR1(I) + Y1/NBNN
  96. END DO
  97. DO L=1,NBNN
  98. X1 = XE(1,L) - XCTR1(I)
  99. Y1 = XE(2,L) - YCTR1(I)
  100. ALPHA1(L) = ATAN2(X1,Y1)
  101. XP(L) = X1
  102. YP(L) = Y1
  103. END DO
  104.  
  105. DO L=1,NBNN1
  106. DO L1=L,NBNN
  107.  
  108. IF (ALPHA1(L).GT.ALPHA1(L1)) THEN
  109. ALPH1 = ALPHA1(L1)
  110. ALPHA1(L1)=ALPHA1(L)
  111. ALPHA1(L)=ALPH1
  112. X1 = XP(L1)
  113. Y1 = YP(L1)
  114. XP(L1) = XP(L)
  115. YP(L1) = YP(L)
  116. XP(L) = X1
  117. YP(L) = Y1
  118.  
  119.  
  120. END IF
  121.  
  122. END DO
  123. END DO
  124. * calculer la surface par l'algorithme "shoelace"
  125. DO L=1,NBNN
  126. L1 = L + 1
  127. IF (L1.GT.NBNN) THEN
  128. L1=1
  129. ENDIF
  130. S(I)=S(I) + (YP(L1) + YP(L))*(XP(L)-XP(L1))*0.5D0
  131. END DO
  132.  
  133.  
  134. S(I) = ABS(S(I))
  135. * sommme(1/R*S*epaissseur)
  136. DO K = 1,NBELEM
  137. A1(I,K) = 0.0
  138. CALL DOXE(XCOOR,IDIM,NBNN,IMAIL1.NUM,K,XE)
  139. DO L=1,NBNN
  140. X1 = XE(1,L)
  141. Y1 = XE(2,L)
  142. RDIST = 0.0
  143. DO IG=1,6
  144. XDIST1 = ABS(SQRT((X1-XCTR1(I))**2 + (Y1-YCTR1(I))**2
  145. &+ (ZMAX-ZG2(IG))**2)+ZMAX-ZG2(IG))
  146. XDIST2 = ABS(SQRT((X1-XCTR1(I))**2 + (Y1-YCTR1(I))**2
  147. &+ (ZMIN-ZG2(IG))**2)+ZMIN-ZG2(IG))
  148. RDIST = RDIST + WG1(IG)*LOG(XDIST1/XDIST2)
  149. END DO
  150. A1(I,K) = A1(I,K) + (RDIST*1.E-7)/NBNN*S(I)
  151. END DO
  152. ENDDO
  153. ENDDO
  154. SEGDES,MCOORD
  155.  
  156.  
  157. * On construit la liste des valeurs réelles
  158. * WRITE(IOIMP,*) ' PARTIE 3 : CREATION DE LA LISTE'
  159.  
  160. JG = NBELEM*NBELEM
  161.  
  162. SEGINI,ILREE1
  163.  
  164. MCOMPT = 0
  165. DO I = 1,NBELEM
  166. DO J = 1,NBELEM
  167. MCOMPT = MCOMPT + 1
  168. ILREE1.PROG(MCOMPT) = A1(J,I)
  169. ENDDO
  170. ENDDO
  171.  
  172. RETURN
  173. END
  174.  
  175.  

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