Télécharger la plaquette Cast3M


fr en

Télécharger trihr1.eso

Retour à la liste

Numérotation des lignes : 

trihr1

  1. C TRIHR1    SOURCE    CHAT      05/01/13    03:47:22     5004
  2.       SUBROUTINE TRIHR1(IGAU,ITEL,MFR,NBNO,IFOU,NIFOU,XEL,
  3.      #                  SHPTOT,SHP,NST,ISDJC,XGENE,DJAC,IRET)
  4. C=======================================================================
  5. C
  6. C    CALCULE LA MATRICE XGENE (NECESSAIRE POUR LE CALCUL  DE LA MATRICE
  7. C       DE RIGIDITE DANS LE CAS DE LA FORMULATION (37) HOMOGENE    )
  8. C          ROUTINE FORTRAN PUR
  9. C=======================================================================
  10. C  INPUT
  11. C     IGAU=NUMERO DU POINT DE GAUSS
  12. C     ITEL=NUMERO DE L ELEMENT DANS NOMTP
  13. C     MFR =NUMERO DE LA FORMULATION
  14. C     NBNO=NOMBRE DE NOEUDS
  15. C     LRE =NOMBRE DE COLONNES DE LA MATRICE B
  16. C     IFOU=IFOUR DE CCOPTIO
  17. C     NIFOU=NIFOUR DE CCOPTIO
  18. C     XEL =COORDONNEES  DE L ELEMENT
  19. C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  20. C     ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
  21. C  ZONE DE TRAVAIL
  22. C     SHP(6,NBNO)=TABLEAU DE TRAVAIL
  23. C  OUTPUT
  24. C     ISDJC = INDICATEUR SUR LE SIGNE DU JACOBIEN
  25. C     NST =NBRE DE COLONNES DE LA MATRICE XGENE
  26. C     DJAC=JACOBIEN
  27. C     XGENE(NBNO,NST)=MATRICE (DE FONCTION DE FORME )
  28. C     IRET= INDICATEUR  =  1 : SUCCES
  29. C                       =  0 : ECHEC (ELEMENT INCOMPATIBLE )
  30. C                       =  2 : ECHEC (JACOBIEN NUL         )
  31. C=======================================================================
  32.       IMPLICIT INTEGER(I-N)
  33.       IMPLICIT REAL*8(A-H,O-Z)
  34.       DIMENSION XEL(3,*),XGENE(NBNO,3),SHP(6,*),SHPTOT(6,NBNO,*)
  35.       IF (ITEL.EQ.92.OR.ITEL.EQ.157)              GOTO 10
  36. C
  37. C     ERREUR : TYPE D' ELEMENT  INCOMPATIBLE AVEC LA FORMULATION
  38. C
  39.       IRET = 0
  40.       GOTO 666
  41.   10  CONTINUE
  42.       DO 101 NP=1,NBNO
  43.       SHP(1,NP)=SHPTOT(1,NP,IGAU)
  44.       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  45.       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  46.   101 CONTINUE
  47.       CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,2,1.D0,RR,DJAC)
  48.       IF (DJAC.LT.0.) ISDJC = ISDJC + 1
  49.       IF ( DJAC.EQ.0.) GOTO 667
  50.       DJAC = ABS(DJAC)
  51.       IF (IFOU.EQ.0.OR.IFOU.EQ.1) THEN
  52. C
  53. C     CAS  AXISYMETRIQUE  OU  FOURIER
  54. C     NST  =  3
  55. C
  56.       NST = 3
  57.       CALL ZERO(XGENE,NBNO,NST)
  58.       DO 103 NP=1,NBNO
  59.       XGENE(NP,1)=SHP(1,NP)
  60.   103 CONTINUE
  61.       A1 = XEL(2,2) - XEL(2,3)
  62.       A2 = XEL(2,3) - XEL(2,1)
  63.       A3 = XEL(2,1) - XEL(2,2)
  64.       B1 = XEL(1,3) - XEL(1,2)
  65.       B2 = XEL(1,1) - XEL(1,3)
  66.       B3 = XEL(1,2) - XEL(1,1)
  67. C
  68. C     XJAC  EST LE JACOBIEN ( 2*SURFACE DU TRIANGLE )
  69. C
  70.       XJAC = (B3*A2 -B2*A3)
  71.       IF ( XJAC.EQ.0.) GOTO 667
  72. C
  73. C     (LI = CI + AI*R + BI*Z )
  74. C
  75.       B1 = B1/XJAC
  76.       B2 = B2/XJAC
  77.       B3 = B3/XJAC
  78. C
  79. C     XGENE(NBNO,2 ) = DERIVEE 2ND PAR RAPPORT A Z DES FONCTIONS
  80. C     D' INTERPOLATIONS (CUBIQUE)
  81. C     N1= L1+(L1**2)*L2+(L1**2)*L3-L1*(L2**2)-L1*(L3**2)
  82. C     INTERPOLATION  DES DEPLACEMENTS
  83. C
  84.       XGENE(1,2)=2.D0*(2.D0*B1*(B2+B3)-B2*B2-B3*B3)*XGENE(1,1)+2.D0*B1*
  85.      #(B1-2.D0*B2)*XGENE(2,1)+2.D0*B1*(B1-2.D0*B3)*XGENE(3,1)
  86.       XGENE(2,2)=2.D0*(2.D0*B2*(B3+B1)-B3*B3-B1*B1)*XGENE(2,1)+2.D0*B2*
  87.      #(B2-2.D0*B3)*XGENE(3,1)+2.D0*B2*(B2-2.D0*B1)*XGENE(1,1)
  88.       XGENE(3,2)=2.D0*(2.D0*B3*(B1+B2)-B1*B1-B2*B2)*XGENE(3,1)+2.D0*B3*
  89.      #(B3-2.D0*B1)*XGENE(1,1)+2.D0*B3*(B3-2.D0*B2)*XGENE(2,1)
  90. C
  91. C     XGENE(NBNO,3) = DERIVEE 2ND PAR RAPPORT A Z DES FONCTIONS
  92. C     D' INTERPOLATIONS (CUBIQUE)
  93. C     N2= A2*(L3*(L1**2)+0.5*L1*L2*L3)-A3*(L2*(L1**2)+0.5*L1*L2*L3)
  94. C     INTERPOLATION  DES ROTATIONS
  95. C
  96.       XGENE(1,3)=(4.D0*B1*(A2*B3-A3*B2)+(A2-A3)*B2*B3)*XGENE(1,1)+
  97.      # (2.D0*A2*B1*B1+(A2-A3)*B1*B2)*XGENE(3,1)+
  98.      # ((A2-A3)*B1*B3-2.D0*A3*B1*B1)*XGENE(2,1)
  99.       XGENE(2,3)=(4.D0*B2*(A3*B1-A1*B3)+(A3-A1)*B3*B1)*XGENE(2,1)+
  100.      # (2.D0*A3*B2*B2+(A3-A1)*B2*B3)*XGENE(1,1)+
  101.      # ((A3-A1)*B2*B1-2.D0*A1*B2*B2)*XGENE(3,1)
  102.       XGENE(3,3)=(4.D0*B3*(A1*B2-A2*B1)+(A1-A2)*B1*B2)*XGENE(3,1)+
  103.      # (2.D0*A1*B3*B3+(A1-A2)*B3*B1)*XGENE(2,1)+
  104.      # ((A1-A2)*B3*B2-2.D0*A2*B3*B3)*XGENE(1,1)
  105.       IRET=1
  106.       ELSE
  107. C
  108. C     NST = 1      CAS   PLAN
  109. C     XGENE(I,1) = ( L1 , L2 , L3 )  POUR L ELEMENT  TRIH  (NBNO =3)
  110. C
  111.       NST = 1
  112.       CALL ZERO(XGENE,NBNO,NST)
  113.       DO 102 NP=1,NBNO
  114.       XGENE(NP,1)=SHP(1,NP)
  115.   102 CONTINUE
  116.       IRET=1
  117.       ENDIF
  118.       GOTO  666
  119.  667  CONTINUE
  120. C
  121. C     JACOBIEN  NUL
  122. C
  123.       IRET = 2
  124. C
  125.  666  CONTINUE
  126.       RETURN
  127.       END
  128.  
  129.  
  130.  
  131.  
  132.  

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