Télécharger lispbs.eso

Retour à la liste

Numérotation des lignes :

  1. C LISPBS SOURCE CHAT 05/01/13 01:22:33 5004
  2. SUBROUTINE LISPBS(WORK,VELA,POIGAU,SHPTOT,
  3. 1 NBPGAU,NBNO,XE,XFOLO,BPSS,XFORC)
  4. C=====================================================================
  5. C ENTREES
  6. C
  7. C WORK(NSTRS*NBPGAU) = CONTIEND LES CONTRAINTES DU LINESPRING
  8. C VELA(5*NBPGAU) = CARACTERISTIQUES
  9. C POIGAU(NBPGAU) = POIDS D INTEGRATION
  10. C SHPTOT(6,NBNO,NBPGAU) = FONCTIONS DE FORME
  11. C NBPGAU = NOMBRE DE POINT D INTEGRATION
  12. C NBNO = NOMBRE DE POINT DE L ELEMENT
  13. C XE(3,4) = CORRDONEES DE L ELEMENT
  14. C TRAVAIL
  15. C XFOLO(LRE) = FORCES LOCALES
  16. C BPSS(3,3) = MATRICE DE PASSAGE
  17. C SORTIES
  18. C XFORC(LRE) = FORCE NODALES
  19. C EBERSOLT AVRIL 86 ON SUPPOSE L EPAISSEUR CONSTANTE
  20. C====================================================================
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. PARAMETER(UNSIX=.166666666666666D0,XZER=0.D0,DEUX=2.D0)
  24. PARAMETER(UN=1.D0)
  25. DIMENSION WORK(*),POIGAU(*),SHPTOT(6,NBNO,*)
  26. DIMENSION XFORC(*),XE(3,*),BPSS(3,*),XFOLO(*),VELA(*)
  27. DIMENSION XEP(6),XEL(3,3),IL(6)
  28. C
  29. DATA IL/2,3,1,4,1,5/
  30. C
  31. XEP(1)= UN
  32. XEP(2)= UN
  33. XEP(3)= UN
  34. XEP(4)= UN
  35. XEP(5)= XZER
  36. XEP(6)= UN
  37. C
  38. C ON CALCULE LA MATRICE DE PASSAGE
  39. C
  40. XEL(1,1)=XE(1,1)
  41. XEL(2,1)=XE(2,1)
  42. XEL(3,1)=XE(3,1)¼/lm>
  43. XX=(XE(1,1)-XE(1,2))*(XE(1,1)-XE(1,2))
  44. 1 +(XE(2,1)-XE(2,2))*(XE(2,1)-XE(2,2))
  45. 1 +(XE(3,1)-XE(3,2))*(XE(3,1)-XE(3,2))
  46. XX=SQRT(XX)
  47. C
  48. XEL(1,2)=XE(1,2)
  49. XEL(2,2)=XE(2,2)
  50. XEL(3,2)=XE(3,2)
  51. C
  52. XEL(1,3)=XE(1,1)+VELA(3)
  53. XEL(2,3)=XE(2,1)+VELA(4)
  54. XEL(3,3)=XE(3,1)+VELA(5)
  55. C
  56. CALL VPAST(XEL,BPSS)
  57. C
  58. DO 500 IA=1,6
  59. XEP(IA)=XEP(IA)*XX
  60. 500 CONTINUE
  61. C
  62. DO 100 IA=1,NBNO
  63. IF(IA.EQ.1.OR.IA.EQ.2) YY= UN
  64. IF(IA.EQ.3.OR.IA.EQ.4) YY=-UN
  65. DO 300 IC=1,6
  66. CC=XZER
  67. IX=IC+(IA-1)*6
  68. DO 200 IB=1,NBPGAU
  69. IJ=IL(IC)+(IB-1)*6
  70. CC=CC+SHPTOT(1,IA,IB)*WORK(IJ)*POIGAU(IB)*XEP(IC)*YY
  71. 200 CONTINUE
  72. XFOLO(IX)=CC
  73. 300 CONTINUE
  74. 100 CONTINUE
  75. C
  76. CALL TRPOSE(BPSS)
  77. CALL MATVEC(XFOLO,XFORC,BPSS,8)
  78. C
  79. RETURN
  80. END
  81.  
  82.  

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