Télécharger la plaquette Cast3M


fr en

Télécharger barbs3.eso

Retour à la liste

Numérotation des lignes : 

barbs3

  1. C BARBS3    SOURCE    CB215821  16/04/21    21:15:11     8920
  2. C BARBS3    SOURCE    CHAT      89/05/26    22:56:13
  3.       SUBROUTINE BARBS3(FORCE,XE,CONTG,KERRE,QSIGAU,POIGAU,NBPGAU,IB)
  4. C-----------------------------------------------------------------------
  5. C  ROUTINE DE CALCUL DES FORCES INTERNES B*SIGMA
  6. C             POUR LA BARRE
  7. C
  8. C  ENTREE
  9. C          EFFORT  L'EFFORT DANS LA BARRE
  10. C          XE   XEONNEES DES 2 NOEUDS
  11. C
  12. C  SORTIE
  13. C          FORCE   FORCES INTERNES
  14. C          KERRE   INDICE D'ERREUR ( 0 SI PAS DE PB )
  15. C
  16. C-----------------------------------------------------------------------
  17.       IMPLICIT INTEGER(I-N)
  18.       IMPLICIT REAL*8(A-H,O-Z)
  19. -INC PPARAM
  20. -INC CCOPTIO
  21.       DIMENSION XE(3,*),V(3),FORCE(*),CONTG(*)
  22.       DIMENSION QSIGAU(*),POIGAU(*),B3(3),FL(3)
  23. C
  24.       KERRE=0
  25.       V(3)=0.D0
  26.       DO 1 I=1,IDIM
  27.   1   V(I)=XE(I,3)-XE(I,1)
  28.       XL=(V(1)*V(1)+V(2)*V(2)+V(3)*V(3))
  29.       XL=SQRT(XL)
  30.       IF(XL.LE.0.D0) GO TO 999
  31. *
  32.       SECT=1.D0
  33.       CALL ZERO(FL,3,1)
  34.       DO 5 IGAU=1,NBPGAU
  35.          ATDH=SECT*POIGAU(IGAU)*XL/2.D0
  36.          X1=XL/2.D0*(QSIGAU(IGAU)+1.D0)
  37.          B3(1)=(4.D0*X1/XL-3.D0)/XL
  38.          B3(2)=(4.D0-8.D0*X1/XL)/XL
  39.          B3(3)=(4.D0*X1/XL-1.D0)/XL
  40.          DO 3 I=1,3
  41.            FL(I)=FL(I)+B3(I)*CONTG(IGAU)*ATDH
  42.   3      CONTINUE
  43.   5   CONTINUE
  44. C
  45. C  REMPLISSAGE DU VECTEUR FORCE
  46. C
  47.       DO 2 IN=1,3
  48.       DO 2 I=1,IDIM
  49.         IG=(IN-1)*IDIM+I
  50.         FORCE(IG)=V(I)*FL(IN)/XL
  51.   2   CONTINUE
  52. C--------------------------------------------
  53. *      NRE=LRE
  54. *      WRITE(*,*) '**  B BAR3 (dans barbs3)** ELEME:',IB
  55. *      WRITE(*,1991) (B3(IC),IC=1,3)
  56. *      WRITE(*,*) '**  CONTG BAR3 (dans barbs3)** '
  57. *      WRITE(*,1991) (CONTG(IC),IC=1,3)
  58. *      WRITE(*,*) '**  FL LOCAL BAR3 (dans barbs3)** '
  59. *      WRITE(*,1991) (FL(IC),IC=1,3)
  60. *      WRITE(*,*) '**  FORCE GLOBAL BAR3 (dans barbs3)** '
  61. *      WRITE(*,1991) (FORCE(IC),IC=1,NRE)
  62. *1991  FORMAT(18(1X,E12.5))
  63. C--------------------------------------------
  64.       RETURN
  65. 999   KERRE=1
  66.       RETURN
  67.       END
  68.  
  69.  
  70.  
  71.  
  72.  

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