Télécharger la plaquette Cast3M


fr en

Télécharger chame4.eso

Retour à la liste

Numérotation des lignes : 

chame4

  1. C CHAME4    SOURCE    MB234859  21/11/09    21:15:07     11183          
  2.       SUBROUTINE CHAME4(IPCHAM,IPMINT,MELEME,MELVA3)
  3. *____________________________________________________________________*
  4. *                                                                    *
  5. *     Transformation d'un MCHAML en T TINF TSUP en un MCHAML         *
  6. *     uniquement en T mais dont la répartition est parabolique dans  *
  7. *     l'épaisseur . Ce sous-programme n'est utilisé que pour les     *
  8. *     éléments coques avec intégration dans l'épaisseur              *
  9. *                                                                    *
  10. *     Entr{es:                                                       *
  11. *     ________                                                       *
  12. *                                                                    *
  13. *     IPCHAM       Pointeur sur le MCHAML                            *
  14. *                                                                    *
  15. *     Sorties:                                                       *
  16. *     ________                                                       *
  17. *                                                                    *
  18. *     IPCHAM       Pointeur sur le MCHAML r{sultat                   *
  19. *                                                                    *
  20. *____________________________________________________________________*
  21. *
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24. *
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. *
  29. -INC SMCHAML
  30. -INC SMELEME
  31. -INC SMINTE
  32. *
  33.       CHARACTER*(LOCOMP)  NOMC
  34.       CHARACTER*16 TYPC
  35. *
  36. *----- mise en ordre des composantes : TINF et TSUP en dernier -----
  37. *
  38. *      write(6,*) '2 ipcham,ipmint,meleme',ipcham,ipmint,meleme
  39.       MCHAML = IPCHAM
  40. CC    segact mchaml*mod
  41.       NCOMP = NOMCHE(/2)
  42.       ITINF=0
  43.       ITSUP=0
  44.       IT=0
  45.       DO 10 I1=1,NCOMP
  46.         IF(NOMCHE(I1).EQ.'TINF ') ITINF = I1
  47.         IF(NOMCHE(I1).EQ.'TSUP ') ITSUP = I1
  48.         IF(NOMCHE(I1).EQ.'T    ') IT = I1
  49.   10  CONTINUE
  50.       IF(ITINF*ITSUP*IT.EQ.0) THEN
  51.         moterr(1:8)='CHAME4-2'
  52.         CALL ERREUR(359)
  53.         RETURN
  54.       ENDIF
  55. CC    NLIMIT = NCOMP - 2
  56. C
  57. C------------------ On s'occupe de la composante TINF --------------
  58. C
  59. CC    IF(ITINF.LE.NLIMIT) THEN
  60. CC        IF(NOMCHE(NLIMIT + 1).NE.'TSUP    ') THEN
  61. CC           INTER = IELVAL(ITINF)
  62. CC           NOMC  = NOMCHE(ITINF)
  63. CC           TYPC  = TYPCHE(ITINF)
  64. CC           IELVAL(ITINF) = IELVAL(NLIMIT + 1)
  65. CC           NOMCHE(ITINF) = NOMCHE(NLIMIT + 1)
  66. CC           TYPCHE(ITINF) = TYPCHE(NLIMIT + 1)
  67. CC           ITINF = NLIMIT + 1
  68. CC           IELVAL(ITINF) = INTER
  69. CC           NOMCHE(ITINF) = NOMC
  70. CC           TYPCHE(ITINF) = TYPC
  71. CC        ELSEIF (NOMCHE(NLIMIT + 2).NE.'TSUP    ') THEN
  72. CC           INTER = IELVAL(ITINF)
  73. CC           NOMC  = NOMCHE(ITINF)
  74. CC           TYPC  = TYPCHE(ITINF)
  75. CC           IELVAL(ITINF) = IELVAL(NLIMIT + 2)
  76. CC           NOMCHE(ITINF) = NOMCHE(NLIMIT + 2)
  77. CC           TYPCHE(ITINF) = TYPCHE(NLIMIT + 2)
  78. CC           ITINF = NLIMIT + 2
  79. CC           IELVAL(ITINF) = INTER
  80. CC           NOMCHE(ITINF) = NOMC
  81. CC           TYPCHE(ITINF) = TYPC
  82. CC        ENDIF
  83. CC    ENDIF
  84. C
  85. C------------------ On s'occupe de la composante TSUP --------------
  86. C
  87. CC    IF(ITSUP.LE.NLIMIT) THEN
  88. CC        IF(NOMCHE(NLIMIT + 1).NE.'TINF    ') THEN
  89. CC           INTER = IELVAL(ITSUP)
  90. CC           NOMC  = NOMCHE(ITSUP)
  91. CC           TYPC  = TYPCHE(ITSUP)
  92. CC           IELVAL(ITSUP) = IELVAL(NLIMIT + 1)
  93. CC           NOMCHE(ITSUP) = NOMCHE(NLIMIT + 1)
  94. CC           TYPCHE(ITSUP) = TYPCHE(NLIMIT + 1)
  95. CC           ITSUP = NLIMIT + 1
  96. CC           IELVAL(ITSUP) = INTER
  97. CC           NOMCHE(ITSUP) = NOMC
  98. CC           TYPCHE(ITSUP) = TYPC
  99. CC        ELSEIF (NOMCHE(NLIMIT + 2).NE.'TSUP    ') THEN
  100. CC           INTER = IELVAL(ITSUP)
  101. CC           NOMC  = NOMCHE(ITSUP)
  102. CC           TYPC  = TYPCHE(ITSUP)
  103. CC           IELVAL(ITSUP) = IELVAL(NLIMIT + 2)
  104. CC           NOMCHE(ITSUP) = NOMCHE(NLIMIT + 2)
  105. CC           TYPCHE(ITSUP) = TYPCHE(NLIMIT + 2)
  106. CC           ITSUP = NLIMIT + 2
  107. CC           IELVAL(ITSUP) = INTER
  108. CC           NOMCHE(ITSUP) = NOMC
  109. CC           TYPCHE(ITSUP) = TYPC
  110. CC        ENDIF
  111. CC    ENDIF
  112. CC    DO 11 I1=1,NCOMP
  113. CC       IF(NOMCHE(I1).EQ.'TINF    ') ITINF = I1
  114. CC       IF(NOMCHE(I1).EQ.'TSUP    ') ITSUP = I1
  115. CC       IF(NOMCHE(I1).EQ.'T       ') IT = I1
  116. CC11  CONTINUE
  117. CC    IF( ITINF+ITSUP.NE.NCOMP*2-1) then
  118. CC      moterr(1:8)='CHAME4-1'
  119. CC      call erreur (349)
  120. CC      return
  121. CC    endif
  122. C
  123. CC    SEGACT MELEME
  124.       NBELEM = NUM(/2)
  125. CC    SEGDES MELEME
  126.       MINTE = IPMINT
  127. CC    SEGACT MINTE                     <- Actif en (E/S)
  128.       NBGAUS = POIGAU(/1)
  129. CC    N1EL = NBELEM
  130. CC    N1PTEL = NBGAUS
  131. CC    N2EL = 0
  132. CC    N2PTEL = 0
  133. CC    SEGINI MELVA3
  134. C
  135. C-------------- Calcul de T a partir de T TINF et TSUP -------------
  136. C
  137. C      write(6,*) ' it , itinf, itsup',it , itinf, itsup
  138.       MELVAL = IELVAL(IT)
  139.       MELVA1 = IELVAL(ITINF)
  140.       MELVA2 = IELVAL(ITSUP)
  141. C      write(6,*) '1 melval,melva1,melva2',melval,melva1,melva2
  142. CC    SEGACT MELVAL
  143. CC    SEGACT MELVA1
  144. CC    SEGACT MELVA2
  145.       NPT = VELCHE(/1)
  146.       NEL = VELCHE(/2)
  147.       N1PT = MELVA1.VELCHE(/1)
  148.       N1EL = MELVA1.VELCHE(/2)
  149.       N2PT = MELVA2.VELCHE(/1)
  150.       N2EL = MELVA2.VELCHE(/2)
  151. C      write(6,*) 'NPT ',NPT
  152. C      write(6,*) 'N1PT ',N1PT
  153. C      write(6,*) 'N2PT ',N2PT
  154. C      write(6,*) 'NEL ',NEL
  155. C      write(6,*) 'N1EL ',N1EL
  156. C      write(6,*) 'N2EL ',N2EL
  157. *
  158. *------------------------ boucle sur les elements -----------------
  159. *-------------------- boucle sur les points de gauss --------------
  160. *
  161.       DO 20 I2=1,NBELEM
  162. C        write(6,*) ' '
  163. C        write(6,*) '------------------------------'
  164. C        write(6,*) 'Element numero :',I2
  165.         DO 30 I3=1,NBGAUS
  166. C           write(6,*) 'Point numero :',I3
  167.            IF(NPT.EQ.1.AND.NEL.EQ.1) THEN
  168.               T = VELCHE(1,1)
  169.            ELSEIF(NPT.EQ.1) THEN
  170.               T = VELCHE(1,I2)
  171.            ELSE
  172.               T = VELCHE(I3,I2)
  173.            ENDIF
  174.            IF(N1PT.EQ.1.AND.N1EL.EQ.1) THEN
  175.               TINF = MELVA1.VELCHE(1,1)
  176.            ELSEIF(N1PT.EQ.1) THEN
  177.               TINF = MELVA1.VELCHE(1,I2)
  178.            ELSE
  179.               TINF = MELVA1.VELCHE(I3,I2)
  180.            ENDIF
  181.            IF(N2PT.EQ.1.AND.N2EL.EQ.1) THEN
  182.               TSUP = MELVA2.VELCHE(1,1)
  183.            ELSEIF(N2PT.EQ.1) THEN
  184.               TSUP = MELVA2.VELCHE(1,I2)
  185.            ELSE
  186.               TSUP = MELVA2.VELCHE(I3,I2)
  187.            ENDIF
  188.            ZZ = DZEGAU(I3)
  189. C           write(6,*) 'ZZ ',ZZ
  190. C           write(6,*) 'T : ',T
  191. C           write(6,*) 'TINF : ',TINF
  192. C           write(6,*) 'TSUP : ',TSUP
  193.            TT = (0.5D0 * (TINF + TSUP - (2.D0 * T)) * (ZZ*ZZ))
  194.      1          + (0.5D0*(TSUP - TINF) * ZZ) + T
  195. C           write(6,*) 'Temperature calculee : ',TT
  196.            MELVA3.VELCHE(I3,I2) = TT
  197.   30    CONTINUE
  198.   20  CONTINUE
  199.  
  200. C
  201. C--------- desactivation et suppression des segments ---------------
  202. C
  203. CC    N2 = NLIMIT
  204. CC      SEGADJ MCHAML
  205. CC      write(6,*) ' melval,melva1,melva2',melval,melva1,melva2
  206. CC      SEGSUP MELVAL
  207. CC    IELVAL(IT) = MELVA3
  208. CC      SEGSUP MELVA1,MELVA2
  209. CC    SEGDES MINTE                     <- Actif en (E/S)
  210. CC    SEGDES MELVA3
  211.       RETURN
  212.       END
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  

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