Télécharger defcar.eso

Retour à la liste

Numérotation des lignes :

  1. C DEFCAR SOURCE PV 09/03/12 21:19:07 6325
  2. SUBROUTINE DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR,
  3. . WRK1)
  4. *
  5. ********************************************************
  6. * ENTREES
  7. ********************************************************
  8. *
  9. * NCARR : nombre de composantes des caractéristiques géométriques
  10. * ICARA : dimension de XCAR
  11. * IB : numéro de l'élément
  12. * IGAU : numéro du point de Gauss
  13. * MFR : formulation de l'élément
  14. * MELE : numéro de l'element fini
  15. * IVACAR : pointeur sur un segment mptval de caracteristiques geometrique
  16. *
  17. *******************************************************
  18. * SORTIES
  19. *******************************************************
  20. *
  21. * XCAR(ICARA) : caractéristiques géométriques (WRK1)
  22. *
  23. *******************************************************
  24. *
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8(A-H,O-Z)
  27. *
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMCHAML
  32. -INC SMCOORD
  33. *
  34. SEGMENT MPTVAL
  35. INTEGER IPOS(NS) ,NSOF(NS)
  36. INTEGER IVAL(NCOSOU)
  37. CHARACTER*16 TYVAL(NCOSOU)
  38. ENDSEGMENT
  39. *
  40. SEGMENT WRK1
  41. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  42. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  43. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  44. ENDSEGMENT
  45. *
  46. SEGMENT WRKTRA
  47. REAL*8 TTRAV(NTTRAV)
  48. ENDSEGMENT
  49. *
  50. ICARA=XCAR(/1)
  51. IF(IVACAR.NE.0)THEN
  52. MPTVAL=IVACAR
  53. *
  54. * cas des tuyaux
  55. *
  56. IF(MFR.EQ.13)THEN
  57. DO 2106 IC=1,5
  58. MELVAL=IVAL(IC)
  59. IAUX=MELVAL
  60. IF(IAUX.NE.0)THEN
  61. IBMN=MIN(IB,VELCHE(/2))
  62. IGMN=MIN(IGAU,VELCHE(/1))
  63. XCAR(IC)=VELCHE(IGMN,IBMN)
  64. ELSE
  65. XCAR(IC)=0.D0
  66. ENDIF
  67. 2106 continue
  68. DO 2107 IC=6,NCARR-1
  69. MELVAL=IVAL(IC)
  70. IAUX=MELVAL
  71. IF(IAUX.NE.0)THEN
  72. IBMN=MIN(IB,VELCHE(/2))
  73. IGMN=MIN(IGAU,VELCHE(/1))
  74. XCAR(IC)=VELCHE(IGMN,IBMN)
  75. ELSE
  76. XCAR(IC)=-1.D0
  77. ENDIF
  78. 2107 continue
  79. IF(IVAL(NCARR).NE.0)THEN
  80. MELVAL=IVAL(NCARR)
  81. IBMN=MIN(IB,IELCHE(/2))
  82. IGMN=MIN(IGAU,IELCHE(/1))
  83. IP=IELCHE(IGMN,IBMN)
  84. IREF=(IP-1)*(IDIM+1)
  85. DO 2108 IC=1,IDIM
  86. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  87. 2108 continue
  88. ELSE
  89. DO 2109 IC=1,IDIM
  90. XCAR(NCARR+IC-1)=0.D0
  91. 2109 continue
  92. ENDIF
  93. C
  94. C Poutre 3D
  95. C
  96. ELSE IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
  97. DO 1107 IC=1,NCARR-1
  98. MELVAL=IVAL(IC)
  99. IAUX=MELVAL
  100. IF(IAUX.NE.0)THEN
  101. IBMN=MIN(IB,VELCHE(/2))
  102. IGMN=MIN(IGAU,VELCHE(/1))
  103. XCAR(IC)=VELCHE(IGMN,IBMN)
  104. ELSE
  105. XCAR(IC)=0.D0
  106. ENDIF
  107. 1107 continue
  108. IF(IVAL(NCARR).NE.0)THEN
  109. MELVAL=IVAL(NCARR)
  110. IBMN=MIN(IB,IELCHE(/2))
  111. IGMN=MIN(IGAU,IELCHE(/1))
  112. IP=IELCHE(IGMN,IBMN)
  113. IREF=(IP-1)*(IDIM+1)
  114. DO 1108 IC=1,IDIM
  115. XCAR(NCARR+IC-1)=XCOOR(IREF+IC)
  116. 1108 continue
  117. ELSE
  118. DO 1109 IC=1,IDIM
  119. XCAR(NCARR+IC-1)=0.D0
  120. 1109 continue
  121. ENDIF
  122. C distinction entre poutre bernouilli et poutre timo en ce qui
  123. C concerne le defaut pour les sections reduites de l'effort tranchant
  124. IF(MFR.EQ.7.AND.MELE.EQ.84)THEN
  125. SD=XCAR(4)
  126. SREDY=XCAR(5)
  127. SREDZ=XCAR(6)
  128. IF(SREDY.EQ.0) XCAR(5)=SD
  129. IF(SREDZ.EQ.0) XCAR(6)=SD
  130. ENDIF
  131. C
  132. C Poutre 2D
  133. C
  134. ELSEIF(IDIM.EQ.2)THEN
  135. DO 1106 IC=1,NCARR
  136. MELVAL=IVAL(IC)
  137. IAUX=MELVAL
  138. IF(IAUX.NE.0)THEN
  139. IBMN=MIN(IB,VELCHE(/2))
  140. IGMN=MIN(IGAU,VELCHE(/1))
  141. XCAR(IC)=VELCHE(IGMN,IBMN)
  142. ELSE
  143. * cas des coques minces : défaut de alfah
  144. IF(IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  145. XCAR(IC)=0.66666666666666D0
  146. ELSE
  147. XCAR(IC)=0.D0
  148. ENDIF
  149. ENDIF
  150. 1106 continue
  151. C distinction entre poutre bernouilli et poutre timo en ce qui
  152. C concerne le defaut pour les sections reduites de l'effort tranchant
  153. SD=XCAR(1)
  154. if (ncarr.ge.3) then
  155. SREDY=XCAR(3)
  156. IF(SREDY.EQ.0) XCAR(3)=SD
  157. endif
  158. C
  159. ELSE
  160. DO 1110 IC=1,ICARA
  161. MELVAL=IVAL(IC)
  162. IAUX=MELVAL
  163. IF(IAUX.NE.0)THEN
  164. IBMN=MIN(IB,VELCHE(/2))
  165. IGMN=MIN(IGAU,VELCHE(/1))
  166. XCAR(IC)=VELCHE(IGMN,IBMN)
  167. ELSE
  168. * cas des coques minces : défaut de alfah
  169. IF (IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  170. XCAR(IC)=0.66666666666666D0
  171. ELSE
  172. XCAR(IC)=0.D0
  173. ENDIF
  174. ENDIF
  175. 1110 continue
  176. ENDIF
  177. *
  178. * rearrangement du tableau xcar pour qu'on ait le meme ordre
  179. * que l'ancien chamelem
  180. *
  181. IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
  182. VX=XCAR(ICARA-5)
  183. VY=XCAR(ICARA-4)
  184. VZ=XCAR(ICARA-3)
  185. XCAR(ICARA-5)=XCAR(ICARA-2)
  186. XCAR(ICARA-4)=XCAR(ICARA-1)
  187. XCAR(ICARA-3)=XCAR(ICARA)
  188. XCAR(ICARA-2)=VX
  189. XCAR(ICARA-1)=VY
  190. XCAR(ICARA)=VZ
  191. *
  192. ELSE IF(MFR.EQ.13)THEN
  193. NTTRAV = 7
  194. SEGINI WRKTRA
  195. DO 1111 IC=4,10
  196. TTRAV(IC-3)=XCAR(IC)
  197. 1111 continue
  198. IF(IDIM.EQ.2)THEN
  199. XCAR(4)=XCAR(ICARA-1)
  200. XCAR(5)=XCAR(ICARA)
  201. DO 1112 IC=1,NTTRAV
  202. XCAR(IC+5)=TTRAV(IC)
  203. 1112 continue
  204. ELSE IF(IDIM.EQ.3)THEN
  205. XCAR(4)=XCAR(ICARA-2)
  206. XCAR(5)=XCAR(ICARA-1)
  207. XCAR(6)=XCAR(ICARA)
  208. DO 1113 IC=1,NTTRAV
  209. XCAR(IC+6)=TTRAV(IC)
  210. 1113 continue
  211. ENDIF
  212. SEGSUP WRKTRA
  213. ENDIF
  214. ENDIF
  215. RETURN
  216. END
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  

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