Télécharger calsig.eso

Retour à la liste

Numérotation des lignes :

  1. C CALSIG SOURCE BP208322 17/03/01 21:15:06 9325
  2. SUBROUTINE CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
  3. 1 VALCAR,N2EL,N2PTEL,MFR,IFOU,IB,IGAU,EPAIST,
  4. 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,
  5. 3 XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  6. *_______________________________________________________________________
  7. *
  8. *
  9. * ENTREES :
  10. * ---------
  11. *
  12. * DEPST = INCREMENT DE DEFORMATIONS TOTALES
  13. * DDAUX = MATRICE DE HOOKE ELASTIQUE
  14. * NSTRS = NBRE DE COMPOSANTES DES DEFORMATIONS
  15. * CMATE = NOM DU MATERIAU
  16. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  17. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  18. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  19. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  20. * MFR = NUMERO DE LA FORMULATION
  21. * IFOU = OPTION DE CALCUL
  22. * IB = NUMERO DE L ELEMENT COURANT
  23. * IGAU = NUMERO DU POINT COURANT
  24. * EPAIST= EPAISSEUR
  25. * NBPGAU= NBRE DE POINTS DE GAUSS
  26. * MELE = NUMERO DE L ELEMENT FINI
  27. * NPINT = NBRE DE POINTS D INTEGRATION
  28. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  29. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  30. * SECT = SECTION
  31. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  32. * TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI = TABLEAUX UTILISES
  33. * POUR LE CALCUL DE LA MATRICE DE HOOKE
  34. *
  35. * SORTIE :
  36. * --------
  37. *
  38. * DSIGT = INCREMENT DE CONTRAINTES TOTALES
  39. *
  40. *_______________________________________________________________________
  41. *
  42. IMPLICIT INTEGER(I-N)
  43. IMPLICIT REAL*8(A-H,O-Z)
  44. *
  45. -INC CCREEL
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. *
  50. *_______________________________________________________________________
  51. *
  52. DIMENSION VALMAT(*),VALCAR(*),VAR(1)
  53. DIMENSION TXR(IDIM,*),CRIGI(*),S(3)
  54. DIMENSION DEPST(*),DSIGT(*)
  55. DIMENSION COBMA(20),DDAUX(LHOOK,LHOOK)
  56. DIMENSION DDHOMU(LHOOK,LHOOK)
  57. DIMENSION XLOC(3,3),XGLOB(3,3)
  58. DIMENSION D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
  59. *
  60. PARAMETER(DEUX=2.D0,UNDEMI=.5D0)
  61. PARAMETER(X774=.774596669241483D0)
  62. PARAMETER(SIX=6.D0)
  63. *
  64. CHARACTER*8 CMATE
  65. C
  66. C
  67. IRTD=1
  68. CALL ZERO(COBMA,LHOOK,1)
  69. CALL ZERO(DSIGT,NSTRS,1)
  70. *
  71. IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN
  72. S(1)= XZERO
  73. ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN
  74. S(1)=-X774
  75. S(2)= XZERO
  76. S(3)= X774
  77. ENDIF
  78. *
  79. IF (IB.EQ.1.AND.IGAU.EQ.1) THEN
  80. GOTO 1000
  81. *
  82. ELSEIF (N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN
  83. GOTO 2000
  84. *
  85. ELSEIF (N2PTEL.EQ.1.AND.N2EL.NE.1) THEN
  86. IF (IGAU.EQ.1) THEN
  87. GOTO 1000
  88. ELSE
  89. GOTO 2000
  90. ENDIF
  91. *
  92. ELSE
  93. GOTO 1000
  94. *
  95. ENDIF
  96. C
  97. 1000 CONTINUE
  98. *
  99. * write(6,*) 'calsi , nstrs mfr, nbgmat,nelmat mele , lhook,cmate'
  100. * write(6,*) 'calsig' ,nstrs,mfr, nbgmat,nelmat, mele ,lhook,cmate
  101. IRET=1
  102. CALL ZERO(DDAUX,LHOOK,LHOOK)
  103. *
  104. IF (CMATE.EQ.'ISOTROPE'.or.CMATE.EQ.'IMPELAST') THEN
  105. * Les modeles de comportement necessaitant l'appel a CALSIG ne
  106. * correspondent pas aux modeles de comportement dont la valeur
  107. * de INAT est referencee dans HOOKIS. Par consequent, nous
  108. * CHOISISSONS de fixer ARBITRAIREMENT INAT a 0 dans le present
  109. * sous-programme !
  110. INAT = 0
  111. CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,0.D0,EPAIST,
  112. + INAT,MELE,NPINT,IFOU,1,NBGMAT,NELMAT,
  113. + S,SECT,LHOOK,DDHOMU,DDAUX,
  114. + COBMA,XMOB,IRET)
  115. C
  116. ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
  117. CALL HOOKOR(VALMAT,IB,IGAU,MFR,0.D0,EPAIST,
  118. + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK,
  119. + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX,
  120. + COBMA,XMOB,IRET)
  121. C
  122. ELSE IF (CMATE.EQ.'ANISOTRO') THEN
  123. CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,1,NBGMAT,NELMAT,
  124. + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDAUX,
  125. + MELE,COBMA,XMOB,IRET)
  126. C
  127. ELSE IF (CMATE.EQ.'UNIDIREC') THEN
  128. CALL HOOKUN(VALMAT,IB,IGAU,MFR,0.D0,EPAIST,
  129. + MELE,NPINT,IFOU,1,NBGMAT,NELMAT,SECT,LHOOK,
  130. + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDAUX,
  131. + COBMA,XMOB,IRET)
  132. C
  133. ELSE IF (CMATE.EQ.'HOMOGENE') THEN
  134. CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
  135. + LHOOK,DDAUX,IRET)
  136. C
  137. ELSE IF (CMATE.EQ.'SECTION') THEN
  138. CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOU,
  139. + NBGMAT,NELMAT,SECT,LHOOK,DDAUX,IRET)
  140. C
  141. ENDIF
  142. *
  143. IF (IRET.LE.0 ) GOTO 9990
  144. C
  145. *
  146. * cas des champs uniformes -> on ne recalcule pas DDAUX
  147. *
  148. 2000 CONTINUE
  149. *
  150. * cas des milieux poreux : 2 cas selon la valeur de NSTRS
  151. *
  152. IF(MFR.EQ.33.AND.LHOOK.LT.NSTRS) THEN
  153. *
  154. * cas sigeff
  155. *
  156. IF(XMOB.EQ.0.D0) THEN
  157. UNSURM=0.D0
  158. ELSE
  159. UNSURM=1.D0/XMOB
  160. ENDIF
  161. *
  162. DO 4500 I=1,LHOOK
  163. DSIGT(I)=-COBMA(I)*DEPST(NSTRS)
  164. DO 45001 J=1,LHOOK
  165. DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J)
  166. 45001 CONTINUE
  167. 4500 CONTINUE
  168. DSIGT(NSTRS)=DEPST(NSTRS)*UNSURM
  169. DO 4502 I=1,LHOOK
  170. DSIGT(NSTRS)=DSIGT(NSTRS)+COBMA(I)*DEPST(I)
  171. 4502 CONTINUE
  172. *
  173. * autres cas
  174. *
  175. ELSE
  176. DO 5500 I=1,min(LHOOK,NSTRS)
  177. DSIGT(I)=0.D0
  178. DO 55001 J=1,min(LHOOK,NSTRS)
  179. DSIGT(I)=DSIGT(I)+DDAUX(I,J)*DEPST(J)
  180. 55001 CONTINUE
  181. 5500 CONTINUE
  182. ENDIF
  183. *
  184. * CAS DES TUYAUX FISSURES
  185. *
  186. IF (MFR.EQ.17) THEN
  187. *
  188. YOU=VALMAT(1)
  189. RAYO=VALCAR(1)
  190. EPAI=VALCAR(2)
  191. TETA1=VALCAR(9)*UNDEMI
  192. C CONVERSION DE TETA1 EN RADIAN
  193. TETA = (TETA1 * XPI)/180.D0
  194. TESPI = TETA/XPI
  195. C ON MET DANS 'RAYMO' LE RAYON MOYEN DU TUYAU.
  196. RAYMO =RAYO - (EPAI/DEUX)
  197. C CALCUL DE A COEFIICIENT ZAHOR
  198. RSURT=RAYMO / EPAI
  199. IF(RSURT.LE.10.D0.AND.RSURT.GE.4.9D0) THEN
  200. AXX = ( .125D0*RSURT - .25D0 ) **.25D0
  201. ELSE IF(RSURT.GT.10.D0.AND.RSURT.LE.35.D0) THEN
  202. AXX = ( .4D0*RSURT - 3.D0 ) **.25D0
  203. ELSE
  204. KERRE=3
  205. ENDIF
  206. CALL TUFIFP(TESPI,AXX,FP,FM,FMP,FOP,FOM)
  207. C
  208. C
  209. C FACTEUR D INTENSITE DES CONTRAINTES
  210. C
  211. IF(TETA1.LE.(0.5D0))THEN
  212. DSIGT(7)=XZERO
  213. DSIGT(8)=XZERO
  214. GOTO 9992
  215. ENDIF
  216. SQQ= XPI * RAYMO * TETA
  217. SQQ= SQRT(SQQ)
  218. XEX= SQQ * FOP/(DEUX * XPI * RAYMO *EPAI)
  219. XFL= SQQ * FOM/(XPI * RAYMO * RAYMO *EPAI)
  220. DSIGT(7)=XEX * DSIGT(1) - XFL * DSIGT(6)
  221. C
  222. C CALCUL DES AIRES DE BRECHE NOTE TECHNIQUE DRE/STRE/LMA 85/695
  223. C
  224. SIGM=DSIGT(1)/( DEUX * XPI * RAYMO * EPAI )
  225. SIGF=DSIGT(6)/( XPI * RAYMO * RAYMO * EPAI )
  226. XIM= XPI * RAYMO * RAYMO * DEUX * TETA * TETA * FP /YOU
  227. XIF= XIM * ( .75D0 +(.25D0 * COS ( TETA )))
  228. DSIGT(8)=XIM * SIGM - XIF * SIGF
  229. ENDIF
  230. C
  231. *
  232. * CAS DES LISP ET LISM
  233. *
  234. IF (MFR.EQ.15) THEN
  235. EPA1=VALCAR(1)
  236. EPA2=VALCAR(6)
  237. FISS1=VALCAR(2)
  238. FISS2=VALCAR(7)
  239. FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+
  240. + (FISS2*(UNDEMI-UNDEMI/X774))
  241. FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+
  242. + (FISS2*(UNDEMI+UNDEMI/X774))
  243. W=(EPA1+EPA2)*UNDEMI
  244. H1=UNDEMI-UNDEMI*S(IGAU)
  245. H2=UNDEMI+UNDEMI*S(IGAU)
  246. A= H1*FISS1+H2*FISS2
  247. ASURW=(H1*FISS1+H2*FISS2)/W
  248. CALL LISPFI(ASURW,FM,FF)
  249. X1=DSIGT(1)/W
  250. X4=DSIGT(4)*SIX/(W*W)
  251. XXX=XPI*A
  252. XXX=SQRT(XXX)
  253. XKIE=(X1*FM+X4*FF)*XXX
  254. DSIGT(6)= XKIE
  255. *
  256. ENDIF
  257. *
  258. GOTO 9992
  259. *
  260. * ERREUR , RETOUR
  261. *
  262. 9990 CONTINUE
  263. IRTD=0
  264. *
  265. 9992 RETURN
  266. END
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  

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