Télécharger intcn2.eso

Retour à la liste

Numérotation des lignes :

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

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