Télécharger intcn2.eso

Retour à la liste

Numérotation des lignes :

  1. C INTCN2 SOURCE PV 09/03/12 21:25:20 6325
  2. SUBROUTINE INTCN2(IPVANO,IPGEOM,IPINTE,IPVAEQ)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. ************************************************************************
  6. *
  7. * I N T C N 2
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. * INTEGRATION NUMERIQUE DANS UN DOMAINE BIDIMENSIONNEL DU PRODUIT:
  13. * COEF. * TRANSPOSEE( N )
  14. * COEF. : GRANDEUR PHYSIQUE REPRESENTEE PAR UN CHAMELEM
  15. * N : FONCTIONS DE FORME DE L'ELEMENT MAILLANT LE DOMAINE
  16. * CONSIDERE
  17. *
  18. * MODULES UTILISES:
  19. * -----------------
  20. *
  21. -INC CCOPTIO
  22. -INC CCREEL
  23. -INC SMCHAML
  24. -INC SMELEME
  25. -INC SMINTE
  26. -INC SMCOORD
  27. *
  28. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  29. * -----------
  30. *
  31. * IPVANO (E) POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
  32. * VALEURS NODALES DE NOTRE COEFFICIENT
  33. * IPGEOM (E) POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
  34. * DU DOMAINE D'INTEGRATION
  35. * IPINTE (E) POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
  36. * CARACTERISTIQUES D'INTEGRATION
  37. * +IDIM (E) VOIR CCOPTIO
  38. * +XPI (E) VOIR CCREEL
  39. * IPVAEQ (S) POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES VALEURS
  40. * NODALES EQUIVALENTES
  41. *
  42. * VARIABLES:
  43. * ----------
  44. *
  45. * XE(3,NBPTEL) = COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  46. * A ET S = TABLEAUX DE TRAVAIL
  47. *
  48. REAL*8 S(2,3)
  49. SEGMENT,MMAT1
  50. REAL*8 XE(3,NBPTEL),A(NBPTEL,NBPTEL),SHP(6,NBPTEL)
  51. ENDSEGMENT
  52. *
  53. * CONSTANTES:
  54. * -----------
  55. *
  56. PARAMETER ( O0=0.D0 )
  57. PARAMETER ( O1=1.D0 )
  58. PARAMETER ( O2=2.D0 )
  59. *
  60. * REMARQUES:
  61. * ----------
  62. *
  63. * L'UTILISATION DE CE S-P PRESUPPOSE UN PRE ET POST-TRAITEMENT
  64. * DES SEGMENTS MELVAL PASSES EN TANT QUE PARAMETRES
  65. *
  66. * AUTEUR, DATE DE CREATION:
  67. * -------------------------
  68. *
  69. * DENIS ROBERT,LE 15 AVRIL 1988.
  70. *
  71. * LANGAGE:
  72. * --------
  73. *
  74. * ESOPE + FORTRAN77
  75. *
  76. ************************************************************************
  77. *
  78. * ON RECUPERE LES VALEURS DU COEFFICIENT
  79. *
  80. MELVA1=IPVANO
  81. SEGACT,MELVA1
  82. NBPTE1=MELVA1.VELCHE(/1)
  83. NEL1=MELVA1.VELCHE(/2)
  84. *
  85. * ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION
  86. *
  87. MINTE=IPINTE
  88. SEGACT,MINTE
  89. NBPGAU=POIGAU(/1)
  90. *
  91. * ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  92. *
  93. MELEME=IPGEOM
  94. SEGACT,MELEME
  95. NBPTEL=NUM(/1)
  96. NEL=NUM(/2)
  97. *
  98. * INITIALISATION DU MELVAL QUI CONTIENDRA LES VALEURS EQUIVALENTES
  99. *
  100. N1PTEL=NBPTEL
  101. N1EL=NEL
  102. N2PTEL=0
  103. N2EL=0
  104. SEGINI,MELVAL
  105. IPVAEQ=MELVAL
  106. SEGINI,MMAT1
  107. *
  108. * BOUCLE SUR LES ELEMENTS
  109. *
  110. DO 10 IEL=1,NEL
  111. *
  112. * ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
  113. *
  114. CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  115. CALL ZERO(A,NBPTEL,NBPTEL)
  116. *
  117. * BOUCLE SUR LES POINTS DE GAUSS
  118. *
  119. DO 20 IGAU=1,NBPGAU
  120. *
  121. * CALCUL DU JACOBIEN AU POINT DE GAUSS CONSIDERE
  122. *
  123. DO 30 IP = 1,2
  124. IP1 = IP + 1
  125. DO 30 IQ = 1,3
  126. S(IP,IQ) = XZERO
  127. DO 40 IR = 1,NBPTEL
  128. S(IP,IQ)=S(IP,IQ)+SHPTOT(IP1,IR,IGAU)*XE(IQ,IR)
  129. 40 CONTINUE
  130. * END DO
  131. 30 CONTINUE
  132. * END DO
  133. S1 = S(1,2)*S(2,3)-S(1,3)*S(2,2)
  134. S2 = S(1,3)*S(2,1)-S(1,1)*S(2,3)
  135. S3 = S(1,1)*S(2,2)-S(1,2)*S(2,1)
  136. DJAC = SQRT ( S1*S1 + S2*S2 + S3*S3 )
  137. IF (IFOMOD.EQ.0) THEN
  138. *
  139. * CAS DES ELEMENTS AXISYMETRIQUES
  140. *
  141. DO 41 NP=1,NBPTEL
  142. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  143. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  144. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  145. 41 CONTINUE
  146. * END DO
  147. CALL DISTRR(XE,SHP,NBPTEL,RR)
  148. DJAC=O2*XPI*RR*DJAC
  149. ENDIF
  150. DO 50 INOE=1,NBPTEL
  151. DO 60 INO2=1,NBPTEL
  152. A(INOE,INO2)=A(INOE,INO2)+SHPTOT(1,INOE,IGAU)*
  153. & SHPTOT(1,INO2,IGAU)*POIGAU(IGAU)*DJAC
  154. 60 CONTINUE
  155. * END DO
  156. 50 CONTINUE
  157. * END DO
  158. 20 CONTINUE
  159. * END DO
  160. IEMIN=MIN(NEL1,IEL)
  161. DO 70 INOE=1,NBPTEL
  162. DO 80 INO2=1,NBPTEL
  163. INMIN=MIN(NBPTE1,INO2)
  164. VELCHE(INOE,IEL)=VELCHE(INOE,IEL)+MELVA1.VELCHE(INMIN,IEMIN)*
  165. & A(INO2,INOE)
  166. 80 CONTINUE
  167. * END DO
  168. 70 CONTINUE
  169. * END DO
  170. 10 CONTINUE
  171. * END DO
  172. *
  173. SEGSUP,MMAT1
  174. SEGDES,MELEME,MELVA1,MINTE
  175. SEGDES,MELVAL
  176. *
  177. END
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  

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