Télécharger bsigdi.eso

Retour à la liste

Numérotation des lignes :

  1. C BSIGDI SOURCE FANDEUR 10/12/17 21:15:39 6427
  2.  
  3. SUBROUTINE BSIGDI (IPMAIL,IPMINT,NBPGAU,IVASTR,NSTRS,LRE,LDIFF,
  4. & IVAFOR,NFOR)
  5.  
  6. *----------------------------------------------------------------------*
  7. * CALCUL DES FLUX DE DIFFUSION NODAUX EQUIVALENTS *
  8. * Formulation 'DIFFUSION' (MFR=73) - Elements MASSIFs *
  9. *----------------------------------------------------------------------*
  10. * IPMAIL (E) Pointeur sur un segment MELEME *
  11. * IPMINT (E) Pointeur sur un segment MINTE (ACTIF) *
  12. * NBPGAU (E) Nombre de points d'integration pour les "contraintes" *
  13. * IVASTR (E) pointeur sur un segment MPTVAL contenant les *
  14. * les melvals de contraints *
  15. * NSTRS (E) Nombre de composantes de "contraintes/deformations" *
  16. * LRE (E) Nombre de DDL dans la matrice de "rigidite" *
  17. * LDIFF (E) Nombre de composantes de "deformations" = NSTRS *
  18. * IVAFOR (E) pointeur sur un segment MPTVAL contenant les *
  19. * les melvals de forces *
  20. * NFOR (E) Nombre de composantes de "flux" LRE = NBNN * NFOR *
  21. *----------------------------------------------------------------------*
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24.  
  25. -INC CCOPTIO
  26. -INC CCREEL
  27.  
  28. -INC SMCHAML
  29. -INC SMELEME
  30. -INC SMCOORD
  31. -INC SMINTE
  32.  
  33. SEGMENT MWRK1
  34. REAL*8 XFORC(LRE), XFLUD(NSTRS), XEL(3,NBNN)
  35. REAL*8 SHP(6,NBNN), BGRDIF(LDIFF,LRE)
  36. ENDSEGMENT
  37.  
  38. SEGMENT MPTVAL
  39. INTEGER IPOS(NS) ,NSOF(NS)
  40. INTEGER IVAL(NCOSOU)
  41. CHARACTER*16 TYVAL(NCOSOU)
  42. ENDSEGMENT
  43.  
  44. MELEME = IPMAIL
  45. SEGACT,MELEME
  46. NBNN = NUM(/1)
  47. NBELEM = NUM(/2)
  48.  
  49. MINTE = IPMINT
  50. SEGACT,MINTE
  51.  
  52. SEGINI,MWRK1
  53.  
  54. C-------------------------
  55. C Boucle sur les elements
  56. C-------------------------
  57. DO IEL = 1, NBELEM
  58.  
  59. C - Recuperation des coordonnees des noeuds de l element IEL
  60. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  61.  
  62. C - Initialisation des flux nodaux equivalents
  63. DO ICOMP = 1, LRE
  64. XFORC(ICOMP) = XZero
  65. ENDDO
  66. C
  67. MPTVAL = IVASTR
  68. C-- -- -- -- -- -- -- -- --
  69. C - Boucle sur les points de Gauss
  70. C-- -- -- -- -- -- -- -- --
  71. ISDJC = 0
  72. DO IGAU = 1, NBPGAU
  73. C -- Calcul de la matrice Bdif et du jacobien au point de Gauss IGAU
  74. CALL BDIFF(XEL,SHPTOT(1,1,IGAU),NBNN,LDIFF,1,
  75. & SHP,BGRDIF,DJAC)
  76. IF (DJAC.EQ.XZero) THEN
  77. INTERR(1) = IEL
  78. CALL ERREUR(259)
  79. GOTO 999
  80. ENDIF
  81. IF (DJAC.LT.XZero) ISDJC = ISDJC+1
  82. DJAC = ABS(DJAC)*POIGAU(IGAU)
  83. C -- Recuperation des flux au point d'integration (IGAU)
  84. DO ICOMP = 1, NSTRS
  85. MELVAL = IVAL(ICOMP)
  86. IGMN = MIN(IGAU,VELCHE(/1))
  87. IEMN = MIN(IEL ,VELCHE(/2))
  88. XFLUD(ICOMP) = VELCHE(IGMN,IEMN)
  89. ENDDO
  90. C -- Calcul du terme Bdif * Flux et de la contribution du point IGAU
  91. DO ICOMP = 1, LRE
  92. r_z = XZero
  93. DO JCOMP = 1, NSTRS
  94. r_z = r_z + BGRDIF(JCOMP,ICOMP) * XFLUD(JCOMP)
  95. ENDDO
  96. XFORC(ICOMP) = XFORC(ICOMP) + r_z*DJAC
  97. ENDDO
  98. C-- -- -- -- -- -- -- -- --
  99. ENDDO
  100. C-- -- -- -- -- -- -- -- --
  101. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  102. INTERR(1) = IEL
  103. CALL ERREUR(195)
  104. GOTO 999
  105. ENDIF
  106. C - Stockage de XFORC dans le MELVAL IVAFOR
  107. MPTVAL = IVAFOR
  108. IE = 0
  109. DO IGAU = 1, NBNN
  110. DO ICOMP = 1, NFOR
  111. IE = IE + 1
  112. MELVAL = IVAL(ICOMP)
  113. IEMN = MIN(IEL,VELCHE(/2))
  114. VELCHE(IGAU,IEMN) = XFORC(IE)
  115. ENDDO
  116. ENDDO
  117. C-------------------------
  118. ENDDO
  119. C-------------------------
  120.  
  121. 999 CONTINUE
  122. SEGSUP,MWRK1
  123. SEGDES,MINTE,MELEME
  124.  
  125. RETURN
  126. END
  127.  
  128.  
  129.  

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