Télécharger la plaquette Cast3M


fr en

Télécharger lisps3.eso

Retour à la liste

Numérotation des lignes : 

lisps3

  1. C LISPS3    SOURCE    CHAT      05/01/13    01:23:47     5004
  2.       SUBROUTINE LISPS3(XE,EPA1,FISS1,V1,EPA2,FISS2,V2,D,XDDL,XEL,BPSS,
  3.      1     XDDLOC,NPOINT,XSTRS,I69,I70,I195,I157)
  4. C=======================================================================
  5. C
  6. C      EBERSOLT AVRIL 87   ELEMENT LISM
  7. C  UHLMANN  OCTOBRE 94
  8. C
  9. C  ENTREES                                         C  ENTREES
  10. C    XE(3,4)     = COORDONNEES DE LA POUTRE LINESPRING
  11. C    EPA1        = EPAISSEUR NOEUDS 1 4
  12. C    EPA2        = EPAISSEUR NOEUDS 2 3
  13. C    FISS1       = PROFONDEUR DE LA FISSURE NOEUDS 1 4
  14. C    FISS2       = PROFONDEUR DE LA FISSURE NOEUDS 2 3
  15. C    V1(3)       = VECTEUR ORIENTANT LES NOEUDS 1 4
  16. C    V2(3)       = VECTEUR ORIENTANT LES NOEUDS 2 3
  17. C    D(2,2)      = MATRICE DE HOOKE
  18. C    XDDL(24)    = D.D.L. DU LINESPRING
  19. C    NPOINT      = NOMBRE DE POINTS DE CONTRAINTES
  20. C  TABLEAU DE TRAVAIL
  21. C    XEL(3,3)    = COORDONNEES LOCALES
  22. C    BPSS(3,3)   = MATRICE DE PASSAGE
  23. C    XDDLOC(24)  = D.D.L. LOCAUX
  24. C  SORTIES
  25. C    XSTRS(NPOINT*6)= CONTRAINTES LINESPRING
  26. C    I69         = FISSURE TOTALEMENT TRAVERSANTE  CONTRAINTES MISES A 0
  27. C    I70         = INDICERNABILITE DES 2 LEVRES
  28. C    I343        = PROFONDEUR DE FISSURE NULLE
  29. C    I157        = LES 2 LEVRES SONT TROP ELOIGNEES
  30. C
  31. C=======================================================================
  32. C
  33.       IMPLICIT INTEGER(I-N)
  34.       IMPLICIT REAL*8(A-H,O-Z)
  35. C    Include contenant quelques constantes dont XPI :
  36. -INC CCREEL
  37.       PARAMETER(UNDEMI=.5D0,SIX=6.D0)
  38.       PARAMETER(DOUZE=12.D0,TRSIX=36.D0)
  39.       PARAMETER(EPS=2.D-3,PENA=1.D6,EPSINV=1.D-3,PENB=1.D2)
  40.       PARAMETER(X774=.774596669241483D0)
  41. C
  42.       DIMENSION XE(3,*),D(2,*),XSTRS(*),V1(*),V2(*),BPSS(3,*),XEL(3,*)
  43.       DIMENSION S(3),XDDL(*),XDDLOC(*)
  44. C
  45.       IF(NPOINT.EQ.1) THEN
  46.          S(1)= XZERO
  47.       ELSE IF(NPOINT.EQ.3) THEN
  48.          S(1)=-X774
  49.          S(2)= XZERO
  50.          S(3)= X774
  51.       ENDIF
  52. C
  53. C    ON RECUPERE LES FISS AUX POINTS DE GAUSS IL FAUT LES CALCULER
  54. C          AUX EXTREMITES
  55. C
  56.       FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+(FISS2*(UNDEMI-UNDEMI/X774))
  57.       FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+(FISS2*(UNDEMI+UNDEMI/X774))
  58. C
  59.       NPOIN6=6*NPOINT
  60. C
  61. C     MISE A ZERO DES CONTRAINTES  DES INDICATEURS D ERREURS ET DES D.D.
  62. C
  63.       DO  90 IA=1,NPOIN6
  64.          XSTRS(IA)=XZERO
  65.  90   CONTINUE
  66.       I69 =0
  67.       I70 =0
  68. C      I343=0
  69.       I157=0
  70.       I195=0
  71. C
  72.       IF(FISS1.LT.XZERO) THEN
  73. C         I343=1
  74.          FISS1=XZERO
  75.       ENDIF
  76. C
  77.       IF(FISS2.LT.XZERO) THEN
  78. C         I343=1
  79.          FISS2=XZERO
  80.       ENDIF
  81. C
  82. C     EXTRACTION DE LA MATRICE DE PASSAGE
  83. C
  84.       DO 100 IA=1,3
  85.          XEL(IA,1)=XE(IA,1)
  86.          XEL(IA,2)=XE(IA,2)
  87.          XEL(IA,3)=XE(IA,1)+(V1(IA)+V2(IA))*UNDEMI
  88.  100  CONTINUE
  89. C
  90. C-----------------------------------------------
  91.       CALL VPAST(XEL,BPSS)
  92.       CALL MATVEC(XDDL,XDDLOC,BPSS,8)
  93. C-----------------------------------------------
  94. C     système local: x,y et z
  95. C     Noeud 1 (_NO1):
  96. C      XNO1=(XE(1,1)*BPSS(1,1))+(XE(2,1)*BPSS(1,2))+(XE(3,1)*BPSS(1,3))
  97. C      YNO1=(XE(1,1)*BPSS(2,1))+(XE(2,1)*BPSS(2,2))+(XE(3,1)*BPSS(2,3))
  98. C      ZNO1=(XE(1,1)*BPSS(3,1))+(XE(2,1)*BPSS(3,2))+(XE(3,1)*BPSS(3,3))
  99. C     Noeud2  (_NO2):
  100. C      XNO2=(XE(1,2)*BPSS(1,1))+(XE(2,2)*BPSS(1,2))+(XE(3,2)*BPSS(1,3))
  101. C      YNO2=(XE(1,2)*BPSS(2,1))+(XE(2,2)*BPSS(2,2))+(XE(3,2)*BPSS(2,3))
  102.       ZNO2=(XE(1,2)*BPSS(3,1))+(XE(2,2)*BPSS(3,2))+(XE(3,2)*BPSS(3,3))
  103. C     Noeud 3 (_NO3):
  104. C      XNO3=(XE(1,3)*BPSS(1,1))+(XE(2,3)*BPSS(1,2))+(XE(3,3)*BPSS(1,3))
  105. C      YNO3=(XE(1,3)*BPSS(2,1))+(XE(2,3)*BPSS(2,2))+(XE(3,3)*BPSS(2,3))
  106.       ZNO3=(XE(1,3)*BPSS(3,1))+(XE(2,3)*BPSS(3,2))+(XE(3,3)*BPSS(3,3))
  107. C
  108. C     Direction z: Différence entre noeud 2 et noeud 3:
  109.       DZ23 = ZNO2 - ZNO3
  110. C     ________________________________________________________________
  111. C
  112.       DJA1=XZERO
  113.       DJA2=XZERO
  114.       DO 105 IA=1,3
  115.          DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA)
  116.          DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA)
  117.  105  CONTINUE
  118.       DJAC=DJA1*DJA2
  119.       IF(DJAC.LT.-1.D-20) I195=1
  120. C     HAUT  = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3                                                                                C     HAUT
  121. C = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3
  122.       HAUT=XZERO
  123.       XLARG1=XZERO
  124.       XLARG2=XZERO
  125.       DO 110 IA=1,3
  126.          HAUT  =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT
  127.          XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1
  128.          XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2
  129.  110  CONTINUE
  130.       HAUT  =SQRT(HAUT)
  131.       XLARG1=SQRT(XLARG1)
  132.       XLARG2=SQRT(XLARG2)
  133.       EPS1=XLARG1/HAUT
  134.       EPS2=XLARG2/HAUT
  135.       IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1
  136.       DJA1=DJA1/HAUT
  137.       DJA2=DJA2/HAUT
  138.       IF(DJA1.LT.1.D-6.AND.DJA2.LT.1.D-6) I70=1
  139. C
  140. C     ASURW  = A  /  W   NOTATION CHEISSOUX
  141. C
  142.       W=(EPA1+EPA2)*UNDEMI
  143.       ASURW=(FISS1+FISS2)/W
  144.       ASUR1=FISS1/W
  145.       ASUR2=FISS2/W
  146.       IF(ASUR1.GT..98D0.AND.ASUR2.GT..98D0) I69=1
  147.       IF(I69.EQ.1) GOTO 666
  148. C
  149. C     TRANSFORMATION DE D
  150.       D(1,1)=D(1,1)*W
  151.       D(2,2)=D(2,2)*W*W*W/DOUZE
  152. C
  153.       PEWM=D(1,1)*PENA
  154.       PEWF=D(2,2)*PENA
  155.       PEWMB=D(1,1)*PENB
  156.       PEWFB=D(2,2)*PENA
  157.       IF (ASURW.GT.EPSINV) THEN
  158. C
  159. C     BOUCLE SUR LES POINTS DE CONTRAINTES
  160. C
  161.          DO 200 IA=1,NPOINT
  162.             H1=UNDEMI-UNDEMI*S(IA)
  163.             H2=UNDEMI+UNDEMI*S(IA)
  164.             ASURW=(H1*FISS1+H2*FISS2)/W
  165.             A    = H1*FISS1+H2*FISS2
  166. C
  167. C     ON RECUPERE LES COEFFICIENTS ALPHAS ET F I
  168. C--------------------------------------------------
  169.             CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA)
  170.             CALL LISPFI(ASURW,FM,FF)
  171. C     CALL INTER2D
  172. C--------------------------------------------------
  173.             DELTA=D(1,1)/DELTA
  174. C
  175. C     CALCUL DES COEFFICIENTS R1 R2 R3 R4
  176. C
  177.             R1= DELTA*ALFF/W
  178.             R2=-DELTA*ALMF/SIX
  179.             R3=-DELTA*ALMF/SIX
  180.             R4= DELTA*ALMM*W/TRSIX
  181. C
  182. C     REMPLISSAGE DES CONTRAINTES
  183. C
  184.             IF (DZ23.GE.0) THEN
  185.                EPXZ=(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))
  186.      $              *H2
  187.                EPYZ=(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))
  188.      $              *H2
  189.                DD  =(XDDLOC(3 )-XDDLOC(21))*H1+(XDDLOC(9 )-XDDLOC(15))
  190.      $              *H2
  191.                RT  =(XDDLOC(4 )-XDDLOC(22))*H1+(XDDLOC(10)-XDDLOC(16))
  192.      $              *H2
  193.                RTZZ=(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))
  194.      $              *H2
  195.             ELSE
  196.                EPXZ=(XDDLOC(19)-XDDLOC(1 ))*H1+(XDDLOC(13)-XDDLOC(7 ))
  197.      $              *H2
  198.                EPYZ=(XDDLOC(20)-XDDLOC(2 ))*H1+(XDDLOC(14)-XDDLOC(8 ))
  199.      $              *H2
  200.                DD  =(XDDLOC(21)-XDDLOC(3 ))*H1+(XDDLOC(15)-XDDLOC(9 ))
  201.      $              *H2
  202.                RT  =(XDDLOC(22)-XDDLOC(4 ))*H1+(XDDLOC(16)-XDDLOC(10))
  203.      $              *H2
  204.                RTZZ=(XDDLOC(24)-XDDLOC(6 ))*H1+(XDDLOC(18)-XDDLOC(12))
  205.      $              *H2
  206.             ENDIF
  207. C     ___________________________________________________________
  208. C
  209.             IX=6*(IA-1)
  210. C
  211.             XSTRS(IX+1)=DD*R1+RT*R2
  212.             XSTRS(IX+2)=PEWMB*EPXZ
  213.             XSTRS(IX+3)=PEWMB*EPYZ
  214.             XSTRS(IX+4)=DD*R3+RT*R4
  215.             XSTRS(IX+5)=PEWFB*RTZZ
  216. C
  217.             X1=XSTRS(IX+1)/W
  218.             X4=XSTRS(IX+4)*SIX/(W*W)
  219. C     ________________________________________
  220. C
  221. C     CALCUL DE K I   ET DE J
  222. C
  223.             XXX=XPI*A
  224.             XXX=SQRT(XXX)
  225.             XKIE       =(X1*FM+X4*FF)*XXX
  226.             XSTRS(IX+6)= XKIE
  227. C
  228.  200     CONTINUE
  229. C
  230. C   SI FISSURE INEXISTANTE
  231. C
  232. C                ON FAIT UN C.S.T. POUR L ELEMENT DU BOUT
  233. C
  234.       ELSE IF(ASURW.LE.EPSINV) THEN
  235. C
  236.          DO 150 IA=1,NPOINT
  237.             H1=UNDEMI-UNDEMI*S(IA)
  238.             H2=UNDEMI+UNDEMI*S(IA)
  239.             EPXZ =(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))*H2
  240.             EPYZ =(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))*H2
  241. C
  242.             DD1  = XDDLOC(3 )-XDDLOC(21)
  243.             DD2  = XDDLOC(9 )-XDDLOC(15)
  244.             DD =  DD1*H1 + DD2*H2
  245. C
  246.             RT1  = XDDLOC(4 )-XDDLOC(22)
  247.             RT2  = XDDLOC(10)-XDDLOC(16)
  248.             RT =  RT1*H1 + RT2*H2
  249. C
  250.             RTZZ =(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))*H2
  251.             IX=6*(IA-1)
  252.             XSTRS(IX+1)=PEWM*DD
  253.             XSTRS(IX+2)=PEWMB*EPXZ
  254.             XSTRS(IX+3)=PEWMB*EPYZ
  255.             XSTRS(IX+4)=PEWF*RT
  256.             XSTRS(IX+5)=PEWFB*RTZZ
  257.             XSTRS(IX+6)=XZERO
  258.  150     CONTINUE
  259.       ENDIF
  260.  666  CONTINUE
  261.       RETURN
  262.       END
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  

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