Télécharger la plaquette Cast3M


fr en

Télécharger intcn2.eso

Retour à la liste

Numérotation des lignes : 

intcn2

  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