Télécharger la plaquette Cast3M


fr en

Télécharger lispbs.eso

Retour à la liste

Numérotation des lignes : 

lispbs

  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)
  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