Télécharger la plaquette Cast3M


fr en

Télécharger chaco1.eso

Retour à la liste

Numérotation des lignes : 

chaco1

  1. C CHACO1    SOURCE    CB215821  26/08/24    21:15:27     12622          
  2.       SUBROUTINE CHACO1(IPSONO,IPSON1,IPSON2,IEP,IPGEOM,IPINTE,IPCHEQ,
  3.      .                  IPCHE1,IPCHE2)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. ************************************************************************
  7. *
  8. *                             C H A C O 1
  9. *                             -----------
  10. *
  11. * FONCTION:
  12. * ---------
  13. *     CAS DES SOURCES VOLUMIQUES
  14. *     COQUES SEGMENT AXISYMETRIQUE ET  TRIANGLE
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19.  
  20. -INC PPARAM
  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. *     IPSONO  (E)  POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES
  32. *     IPSON1     SOURCES
  33. *     IPSON2
  34. *     IEP     (E)  POINTEUR SUR UN SEGMENT MELVAL COTENANT LES EPAISSEUR
  35. *     IPGEOM  (E)  POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
  36. *     IPINTE  (E)  POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
  37. *                  CARACTERISTIQUES D'INTEGRATION
  38. *    +IDIM    (E)  VOIR CCOPTIO
  39. *    +XPI     (E)  VOIR CCREEL
  40. *     IPCHEQ  (S)  POINTEURS SUR DES SEGMENTS MELVAL CONTENANT LES
  41. *     IPCHE1      CHALEURS NODALES EQUIVALENTES
  42. *     IPCHE2
  43. *
  44. * VARIABLES:
  45. * ----------
  46. *
  47. *     XE(3,NBPTEL)  =  COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
  48. *     SURF          =  SURFACE ELEMENTAIRE AU POINT DE GAUSS
  49. *     A ET S        =  TABLEAUX DE TRAVAIL
  50. *
  51.       REAL*8  S(6)
  52.       SEGMENT,MMAT1
  53.          REAL*8 XE(3,NBPTEL),A(NBPTEL,NBPTEL),SHP(6,NBPTEL),AA(NBE,NBE)
  54.       ENDSEGMENT
  55. *
  56. * CONSTANTES:
  57. * -----------
  58. *
  59.       PARAMETER ( O1=1.D0 )
  60.       PARAMETER ( O2=2.D0,O30=30.D0,O8=8.D0,O15=15.D0)
  61. *
  62. * AUTEUR, DATE DE CREATION:
  63. * -------------------------
  64. *
  65. *     P. DOWLATYARI JUIN 90    ADAPTATION DE CHAMAS
  66. *
  67. * LANGAGE:
  68. * --------
  69. *
  70. *     ESOPE + FORTRAN77
  71. *
  72. ************************************************************************
  73. *
  74. *     ON RECUPERE LES VALEURS DES SOURCES
  75. *
  76.       MELVA1=IPSONO
  77.       SEGACT,MELVA1
  78.       NBPTE1=MELVA1.VELCHE(/1)
  79.       NEL1=MELVA1.VELCHE(/2)
  80.       MELVA2=IPSON1
  81.       SEGACT,MELVA2
  82.       MELVA3=IPSON2
  83.       SEGACT,MELVA3
  84. *
  85. *     ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION
  86. *
  87.       MINTE=IPINTE
  88.       SEGACT,MINTE
  89.       NBPGAU=POIGAU(/1)
  90.       NBNO=SHPTOT(/2)
  91. *
  92. *     ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
  93. *
  94.       MELEME=IPGEOM
  95.       SEGACT,MELEME
  96.       NBPTEL=NUM(/1)
  97.       NEL=NUM(/2)
  98. *
  99. *     INITIALISATION DES MELVALS QUI CONTIENDRA LES CHALEURS EQUIVALENTE
  100. *
  101.       N1PTEL=NBPTEL
  102.       N1EL=NEL
  103.       N2PTEL=0
  104.       N2EL=0
  105.       NBE=3*NBPTEL
  106.       SEGINI,MELVAL
  107.       IPCHEQ=MELVAL
  108.       SEGINI,MELVA4
  109.       IPCHE1=MELVA4
  110.       SEGINI,MELVA5
  111.       IPCHE2=MELVA5
  112.       SEGINI,MMAT1
  113.       MELVA6=IEP
  114.       SEGACT,MELVA6
  115. *
  116. *     BOUCLE SUR LES ELEMENTS
  117. *
  118.       DO 10 IEL=1,NEL
  119. *
  120. *        ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
  121. *
  122.          CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)
  123. *
  124. *        BOUCLE SUR LES POINTS DE GAUSS
  125. *
  126.          CALL ZERO(A,NBPTEL,NBPTEL)
  127.          DO 40 IGAU=1,NBPGAU
  128.             AXIS=O1
  129.             IF (NBNO.EQ.2) THEN
  130. *
  131. *              CALCUL DE LA LONGUEUR ( POUR L'ELEMENT BARRE )
  132. *
  133.                DLX=XZERO
  134.                DLY=XZERO
  135.                DO 400 INOE=1,NBPTEL
  136.                   DLX=DLX+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
  137.                   DLY=DLY+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
  138.  400              CONTINUE
  139. *              END DO
  140.                SURF=SQRT(DLX**2+DLY**2)
  141.             ELSE
  142. *
  143. *           CALCUL DE LA SURFACE ELEMENTAIRE AU POINT DE GAUSS CONSIDERE
  144. *
  145.             SURFX=XZERO
  146.             SURFY=XZERO
  147.             SURFZ=XZERO
  148.             DO 21 I=1,6
  149.                S(I)=XZERO
  150.  21            CONTINUE
  151. *           END DO
  152.             DO 30 INOE=1,NBPTEL
  153.                S(1)=S(1)+SHPTOT(2,INOE,IGAU)*XE(2,INOE)
  154.                S(2)=S(2)+SHPTOT(3,INOE,IGAU)*XE(3,INOE)
  155.                S(3)=S(3)+SHPTOT(3,INOE,IGAU)*XE(2,INOE)
  156.                S(4)=S(4)+SHPTOT(2,INOE,IGAU)*XE(3,INOE)
  157.                S(5)=S(5)+SHPTOT(3,INOE,IGAU)*XE(1,INOE)
  158.                S(6)=S(6)+SHPTOT(2,INOE,IGAU)*XE(1,INOE)
  159.  30            CONTINUE
  160. *           END DO
  161.             SURFX=S(1)*S(2)-S(3)*S(4)
  162.             SURFY=S(4)*S(5)-S(2)*S(6)
  163.             SURFZ=S(6)*S(3)-S(5)*S(1)
  164.             SURF=SQRT(SURFX**2+SURFY**2+SURFZ**2)
  165.             ENDIF
  166.             IF (IFOMOD.EQ.0) THEN
  167. *
  168. *              CAS DES ELEMENTS AXISYMETRIQUES
  169. *
  170.                DO 41 NP=1,NBPTEL
  171.                   SHP(1,NP)=SHPTOT(1,NP,IGAU)
  172.                   SHP(2,NP)=SHPTOT(2,NP,IGAU)
  173.                   SHP(3,NP)=SHPTOT(3,NP,IGAU)
  174.  41               CONTINUE
  175. *              END DO
  176.                CALL DISTRR(XE,SHP,NBPTEL,RR)
  177.                AXIS=XPI*RR*O2
  178.             ENDIF
  179.             DO 50 INO1=1,NBPTEL
  180.                DO 60 INO2=1,NBPTEL
  181.                   A(INO1,INO2)=A(INO1,INO2)+SHPTOT(1,INO1,IGAU)*
  182.      1            SHPTOT(1,INO2,IGAU)*POIGAU(IGAU)*AXIS*SURF
  183.  60               CONTINUE
  184. *              END DO
  185.  50            CONTINUE
  186. *           END DO
  187.  40         CONTINUE
  188. *        END DO
  189. *
  190. *         RECUPERATION DE L'EPAISSEUR
  191. *
  192.            EP=0.D0
  193.            IEMN=MIN(IEL,MELVA6.VELCHE(/2))
  194.            DO  45  INO=1,NBNO
  195.              INMN=MIN(INO,MELVA6.VELCHE(/1))
  196.              EP=MELVA6.VELCHE(INMN,IEMN)+EP
  197.  45        CONTINUE
  198.            EP=EP/NBNO
  199. *
  200. *           INTEGRATION ANALYTIQUE SUR EPAISSEUR
  201. *
  202.             C1=(O2*EP)/O15
  203.             C2=EP/O15
  204.             C3=-EP/O30
  205.             C4=(O8*EP)/O15
  206.             C5=EP/O15
  207.             C6=(O2*EP)/O15
  208. *
  209.             DO 401 J=1,NBPTEL
  210.             DO 80 I=1,NBPTEL
  211.             AA(I,J)=C1*A(I,J)
  212.   80        CONTINUE
  213.   401       CONTINUE
  214. *
  215. *
  216.             DO 402 J=1,NBPTEL
  217.             DO 90 I=1,NBPTEL
  218.             II=I+NBPTEL
  219.             AA(II,J)=C2*A(I,J)
  220.             AA(J,II)=AA(II,J)
  221.   90        CONTINUE
  222.   402       CONTINUE
  223. *
  224.             DO 403 J=1,NBPTEL
  225.             DO 100 I=1,NBPTEL
  226.             II=I+2*NBPTEL
  227.             AA(II,J)=C3*A(I,J)
  228.             AA(J,II)=AA(II,J)
  229.   100       CONTINUE
  230.   403       CONTINUE
  231. *
  232.             DO 404 J=1,NBPTEL
  233.             JJ=J+NBPTEL
  234.             DO 110 I=1,NBPTEL
  235.             II=I+NBPTEL
  236.             AA(II,JJ)=C4*A(I,J)
  237.   110       CONTINUE
  238.   404       CONTINUE
  239. *
  240.             DO 405 J=1,NBPTEL
  241.             JJ=J+NBPTEL
  242.             DO 120 I=1,NBPTEL
  243.             II=I+2*NBPTEL
  244.             AA(II,JJ)=C5*A(I,J)
  245.             AA(JJ,II)=AA(II,JJ)
  246.   120       CONTINUE
  247.   405       CONTINUE
  248. *
  249.             DO 406 J=1,NBPTEL
  250.             JJ=J+2*NBPTEL
  251.             DO 130 I=1,NBPTEL
  252.             II=I+2*NBPTEL
  253.             AA(II,JJ)=C6*A(I,J)
  254.   130       CONTINUE
  255.   406       CONTINUE
  256. *
  257. *           (INTEGRAL DE HTH)*VALEURS NODALES DES SOURCES
  258. *
  259.          IEMIN=MIN(NEL1,IEL)
  260.          DO 407 INO3=1,NBE
  261.          DO 70 INO4=1,NBE
  262.            IF(INO3.LE.NBPTEL)THEN
  263.               IF(INO4.LE.NBPTEL)THEN
  264.                INMIN=MIN(NBPTE1,INO4)
  265.          VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA1.VELCHE(INMIN,IEMIN)*
  266.      1                   AA(INO4,INO3)
  267.               ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  268.                INO5=INO4-NBPTEL
  269.                INMIN=MIN(NBPTE1,INO5)
  270.          VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA2.VELCHE(INMIN,IEMIN)*
  271.      1                    AA(INO4,INO3)
  272.              ELSE
  273.                INO5=INO4-2*NBPTEL
  274.                INMIN=MIN(NBPTE1,INO5)
  275.          VELCHE(INO3,IEL)=VELCHE(INO3,IEL)+MELVA3.VELCHE(INMIN,IEMIN)*
  276.      1                    AA(INO4,INO3)
  277.                ENDIF
  278.            ELSEIF(INO3.GT.NBPTEL.AND.INO3.LE.(2*NBPTEL))THEN
  279.            INO6=INO3 - NBPTEL
  280.               IF(INO4.LE.NBPTEL)THEN
  281.                INMIN=MIN(NBPTE1,INO4)
  282.                MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  283.      1                  MELVA1.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  284.                ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  285.                 INO5=INO4-NBPTEL
  286.                 INMIN=MIN(NBPTE1,INO5)
  287.                 MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  288.      1                  MELVA2.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  289.                ELSE
  290.                 INO5=INO4-2*NBPTEL
  291.                 INMIN=MIN(NBPTE1,INO5)
  292.                 MELVA4.VELCHE(INO6,IEL)=MELVA4.VELCHE(INO6,IEL)+
  293.      1                  MELVA3.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  294.                 ENDIF
  295.            ELSE
  296.            INO6=INO3 -2*NBPTEL
  297.               IF(INO4.LE.NBPTEL)THEN
  298.                INMIN=MIN(NBPTE1,INO4)
  299.                MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  300.      1                  MELVA1.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  301.                ELSEIF(INO4.GT.NBPTEL.AND.INO4.LE.(2*NBPTEL))THEN
  302.                 INO5=INO4-NBPTEL
  303.                 INMIN=MIN(NBPTE1,INO5)
  304.                 MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  305.      1                  MELVA2.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  306.                ELSE
  307.                 INO5=INO4-2*NBPTEL
  308.                 INMIN=MIN(NBPTE1,INO5)
  309.                 MELVA5.VELCHE(INO6,IEL)=MELVA5.VELCHE(INO6,IEL)+
  310.      1                  MELVA3.VELCHE(INMIN,IEMIN)*AA(INO4,INO3)
  311.                 ENDIF
  312.               ENDIF
  313.  70       CONTINUE
  314.   407    CONTINUE
  315. *           END DO
  316.  10      CONTINUE
  317. *     END DO
  318. *
  319.       SEGSUP,MMAT1
  320.       END
  321.  
  322.  
  323.  
  324.  

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