Télécharger la plaquette Cast3M


fr en

Télécharger lispk2.eso

Retour à la liste

Numérotation des lignes : 

lispk2

  1. C LISPK2    SOURCE    CHAT      05/01/13    01:22:52     5004
  2.       SUBROUTINE LISPK2(XE,EPAI,V1,XMAT,XSTRS,XCAR,VAR,NSTRS,
  3.      1 NPOINT,MELE,XPREC,XEL,BPSS,REL,I70,I343,I157,I158,ILO11,KERRE)
  4. C=======================================================================
  5. C
  6. C      EBERSOLT MARS 85
  7. C  ENTREES
  8. C    XE(3,4)     = COORDONNEES DE LA POUTRE LINESPRING
  9. C    EPAI        = EPAISSEUR NOEUDS 1 2 3 4
  10. C    V1(3)       = VECTEUR ORIENTANT LES NOEUDS 1 2 3 4
  11. C    XMAT(15)           = MATERIAU
  12. C    XSTRS(NBGS*NSTRS)  = CONTRAINTES DANS LE LINESPRING
  13. C    XCAR(15)           = CARACTERISTIQUES
  14. C    VAR(NBGS*NSTRS)    = CONTRAINTES DANS LE LINESPRING
  15. C    NSTRS       = NOMBRE DE CONTRAINTES
  16. C    NPOINT      = NOMBRE DE POINTS D INTEGRATION
  17. C    MELE        = 30 OU 50 NUMERO DE L ELEMENT
  18. C    XPREC       = PRECISION
  19. C  TABLEAU DE TRAVAIL
  20. C    XEL(3,3)    = COORDONNEES LOCALES
  21. C    BPSS(3,3)   = MATRICE DE PASSAGE
  22. C  SORTIES
  23. C    REL(24,24)  = MATRICE DE  RIGIDITE  AXES GLOBAUX
  24. C    I70         = INDICERNABILITE DES 2 LEVRES
  25. C    I343        = LA FISSURE DE PROFONDEUR NEGATIVE
  26. C    I157        = LES 2 LEVRES SONT TROP ELOIGNEES
  27. C    I158        = FISSURE TOTALEMENT TRAVERSANTE    RIGIDITE NULLE
  28. C    ILO11=-1    = EN DEHORS DE LA SURFACE DE CHARGE
  29. C           1      C EST O.K.
  30. C    KERRE       = 0    O.K.
  31. C                  30   CONTRAINTE   ULTIME NULLE
  32. C=======================================================================
  33.       IMPLICIT INTEGER(I-N)
  34.       IMPLICIT REAL*8(A-H,O-Z)
  35.       PARAMETER(X774=.774596669241483D0)
  36.       PARAMETER(IZERO=0)
  37.       PARAMETER(EPS=1.D-3,PENA=1.D6,PENB=1.D2,EPSINV=1.D-3)
  38.       PARAMETER(XZER=0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,SIX=6.D0)
  39.       PARAMETER(DOUZE=12.D0,TRSIX=36.D0,QUATRE=4.D0)
  40. C
  41.       DIMENSION XE(3,*),REL(24,*),V1(*),BPSS(3,*),XEL(3,*)
  42.       DIMENSION XSTRS(*),XMAT(*),XCAR(*),VAR(*)
  43.       DIMENSION S(3),POIDS(3)
  44. C
  45.       XPRECM = - XPREC * UNDEMI
  46.       XPRECP =   XPREC * UNDEMI
  47.       ILO11=1
  48.       KERRE=0
  49. C
  50.       S(1)=-X774
  51.       S(2)= XZER
  52.       S(3)= X774
  53.       POIDS(1)=5.D0/9.D0
  54.       POIDS(2)=8.D0/9.D0
  55.       POIDS(3)=5.D0/9.D0
  56. C
  57. C     MISE A XZER DE LA RIGIDITE  ET DES INDICATEURS D ERREUR
  58. C
  59.       CALL ZERO(REL,24,24)
  60.       I70 =0
  61.       I343=0
  62.       I157=0
  63.       I158=0
  64. C
  65.       IF(XCAR(2).LT.XZER) THEN
  66.       I343=1
  67.       FIS10=XZER
  68.       ELSE
  69.       FIS10=XCAR(2)
  70.       ENDIF
  71. C
  72.       IF(XCAR(12).LT.XZER) THEN
  73.       I343=1
  74.       FIS30=XZER
  75.       ELSE
  76.       FIS30=XCAR(12)
  77.       ENDIF
  78. C
  79. C     EXTRACTION DE LA MATRICE DE PASSAGE
  80. C
  81.       DO 100 IA=1,3
  82.       XEL(IA,1)=XE(IA,1)
  83.       XEL(IA,2)=XE(IA,2)
  84.       XEL(IA,3)=XE(IA,1)+V1(IA)
  85.  100  CONTINUE
  86.       CALL VPAST(XEL,BPSS)
  87.       DJA1=XZER
  88.       DJA2=XZER
  89.       DO 105 IA=1,3
  90.       DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA)
  91.       DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA)
  92.  105  CONTINUE
  93.       DJAC=DJA1*DJA2
  94.       IF(DJAC.LT.0.) I195=1
  95. C
  96. C     HAUT  = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3
  97. C
  98.       HAUT=XZER
  99.       XLARG1=XZER
  100.       XLARG2=XZER
  101.       DO 110 IA=1,3
  102.       HAUT  =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT
  103.       XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1
  104.       XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2
  105.   110 CONTINUE
  106.       HAUT  =SQRT(HAUT)
  107.       XLARG1=SQRT(XLARG1)
  108.       XLARG2=SQRT(XLARG2)
  109.       EPS1=XLARG1/HAUT
  110.       EPS2=XLARG2/HAUT
  111.       IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1
  112.       DJA1=DJA1/HAUT
  113.       DJA2=DJA2/HAUT
  114.       IF(DJA1.LT.1.D-3.AND.DJA2.LT.1.D-3) I70=1
  115.       ASUR1=FIS10/EPAI
  116.       ASUR3=FIS30/EPAI
  117.       ASUR0=(FIS10 + FIS30 ) / EPAI
  118.       IF(ASUR1.GT..98.AND.ASUR3.GT..98) I158=1
  119.       IF(I158.EQ.1)   GOTO 666
  120. C
  121. C     ON RECUPERE LES VALEURS DU MODULE D YOUNG
  122. C
  123.       YOU = XMAT(1)
  124.       XNU = XMAT(2)
  125.       SIGY= XMAT(5)
  126. C
  127. C        PENALISATION NORMALE
  128. C
  129.       DDD = YOU * UNDEMI / ( UN - XNU * XNU )
  130.       PEWM=DDD *EPAI*PENA*HAUT/SIX
  131.       PEWF=PEWM*EPAI*EPAI/DOUZE
  132.       PEWM2=DEUX*PEWM
  133.       PEWF2=DEUX*PEWF
  134. C
  135. C     PENALISATION SOUS INTEGRE
  136. C
  137.       PEWM15=DDD*EPAI*PENB*HAUT/QUATRE
  138.       PEWF15=PEWM15*EPAI*EPAI/DOUZE
  139. C
  140. C     PENALISATION DES TERMES CONCERNANT K I SI FISSURE INEXISTANTE
  141. C
  142.       IF(ASUR0.GT.EPSINV) GOTO 366
  143.       REL(3 ,3 )=PEWM2
  144.       REL(4 ,4 )=PEWF2
  145.       REL(9 ,9 )=PEWM2
  146.       REL(10,10)=PEWF2
  147.       REL(3 ,9 )=PEWM
  148.       REL(9 ,3 )=PEWM
  149.       REL(10,4 )=PEWF
  150.       REL(4 ,10)=PEWF
  151.       GOTO 466
  152.   366 CONTINUE
  153. C
  154. C     INTEGRATION NORMALE
  155. C
  156.       X1=XZER
  157.       X2=XZER
  158.       X3=XZER
  159.       X4=XZER
  160.       X5=XZER
  161.       X6=XZER
  162.       X7=XZER
  163.       X8=XZER
  164.       X9=XZER
  165.       DO 500 IA=1,NPOINT
  166.       H1=UNDEMI-UNDEMI*S(IA)
  167.       H2=UNDEMI+UNDEMI*S(IA)
  168.       NCC = ( IA - 1 ) * 5
  169.       NSS = ( IA - 1 ) * NSTRS
  170.       NVV = ( IA - 1 ) * 2
  171.       NMM = ( IA - 1 ) * 5
  172. C
  173.       ASURW=XCAR(NCC+2)/EPAI
  174.       YOU = XMAT(NMM+1)
  175.       XNU = XMAT(NMM+2)
  176.       SIGY= XMAT(NMM+5)
  177.       IF(SIGY.LE.XZER) KERRE=30
  178.       DDD = YOU * UNDEMI / ( UN - XNU * XNU )
  179.       CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA)
  180.       DELTA=POIDS(IA)*DDD*HAUT*UNDEMI/DELTA
  181. C
  182.       D11 = DELTA * ALFF
  183.       D12 = DELTA * ALMF * EPAI / SIX
  184.       D21 = DELTA * ALMF * EPAI / SIX
  185.       D22 = DELTA * ALMM * EPAI * EPAI / TRSIX
  186. C
  187. C     CALCUL DES DERIVEES
  188. C
  189.       IF(SIGY.EQ.XZER) GOTO 111
  190.       CALL LISPPA(ASURW,EPAI,SIGY,GA,GB,A,B,C,D,E,F)
  191.       XN = XSTRS(NSS+1)
  192.       XM = XSTRS(NSS+4)
  193. C
  194. C       VERIFICATION A L INTERIEUR DE LA SURFACE DE CHARGE OU PAS
  195. C
  196.       CALL LISPQ(XN,XM,EPAI,SIGY,GA,GB,ASURW,Q)
  197.       IF(VAR(NVV+1).EQ.XZER.AND.Q.LE.XZER) THEN
  198.       ILOPL=0
  199.       ELSE IF(VAR(NVV+1).EQ.XZER.AND.Q.GT.XZER) THEN
  200.       ILOPL=-1
  201.       ILO11=-1
  202.       ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.LT.XPRECM) THEN
  203.       ILOPL=0
  204.       ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.GE.XPRECM.AND.Q.LE.XPRECP) THEN
  205.       ILOPL=1
  206.       ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.GT.XPRECP) THEN
  207.       ILOPL=-1
  208.       ILO11=-1
  209.       ENDIF
  210. C
  211. C       MATRICE DE RAIDEUR OU MATRICE TANGENTE
  212. C
  213.       IF(ILOPL.EQ.1) THEN
  214.       DFIDN = A * XN + B * XM  + E
  215.       DFIDM = B * XN + D * XM  + F
  216.       U =  D11 * DFIDN + D12 * DFIDM
  217.       V =  D21 * DFIDN + D22 * DFIDM
  218. C
  219.       DENOM = U * DFIDN + V * DFIDM
  220.       D11 = D11 - U * U / DENOM
  221.       D12 = D12 - U * V / DENOM
  222.       D21 = D21 - V * U / DENOM
  223.       D22 = D22 - V * V / DENOM
  224.       ENDIF
  225.   111 CONTINUE
  226. C
  227.       X1=X1+H1*H1*D11
  228.       X2=X2-H1*H1*D12
  229.       X3=X3+H1*H1*D22
  230. C
  231.       X4=X4+H1*H2*D11
  232.       X5=X5-H1*H2*D12
  233.       X6=X6+H1*H2*D22
  234. C
  235.       X7=X7+H2*H2*D11
  236.       X8=X8-H2*H2*D12
  237.       X9=X9+H2*H2*D22
  238.   500 CONTINUE
  239. C
  240. C     MISE EN PLACE DANS LA MATRICE DE RIGIDITE
  241. C
  242.       REL(3 ,3 )=X1
  243.       REL(3 ,4 )=X2
  244.       REL(4 ,3 )=X2
  245.       REL(4 ,4 )=X3
  246. C
  247.       REL(9 ,3 )=X4
  248.       REL(9 ,4 )=X5
  249.       REL(10,3 )=X5
  250.       REL(10,4 )=X6
  251. C
  252.       REL(3 ,9 )=X4
  253.       REL(3 ,10)=X5
  254.       REL(4 ,9 )=X5
  255.       REL(4 ,10)=X6
  256. C
  257.       REL(9 ,9 )=X7
  258.       REL(9 ,10)=X8
  259.       REL(10,9 )=X8
  260.       REL(10,10)=X9
  261. C
  262. C     PENALISATION DES TERMES NE CONCERNANT PAS K I
  263. C
  264.   466 CONTINUE
  265. C
  266.       IF(MELE.EQ.30) THEN
  267.       REL(1 ,1 )=PEWM2
  268.       REL(2 ,2 )=PEWM2
  269.       REL(6 ,6 )=PEWF2
  270. C
  271.       REL(7 ,7 )=PEWM2
  272.       REL(8 ,8 )=PEWM2
  273.       REL(12,12)=PEWF2
  274. C
  275.       REL(1 ,7 )=PEWM
  276.       REL(7 ,1 )=PEWM
  277.       REL(2 ,8 )=PEWM
  278.       REL(8 ,2 )=PEWM
  279.       REL(6 ,12)=PEWF
  280.       REL(12,6 )=PEWF
  281. C
  282.       ELSE IF(MELE.EQ.50) THEN
  283.       REL(1 ,1 )=PEWM15
  284.       REL(2 ,2 )=PEWM15
  285.       REL(6 ,6 )=PEWF15
  286. C
  287.       REL(7 ,7 )=PEWM15
  288.       REL(8 ,8 )=PEWM15
  289.       REL(12,12)=PEWF15
  290. C
  291.       REL(1 ,7 )=PEWM15
  292.       REL(7 ,1 )=PEWM15
  293.       REL(2 ,8 )=PEWM15
  294.       REL(8 ,2 )=PEWM15
  295.       REL(6 ,12)=PEWF15
  296.       REL(12,6 )=PEWF15
  297.       ENDIF
  298. C
  299. C     DOUBLE SYMETRISATION A PARTIR D UNE MATRICE 12 12 ON A UNE 24  24
  300. C
  301.       DO 900 IA=1,6
  302.       DO 900 IB=1,6
  303. C
  304.       REL(IA+18,IB+18)= REL(IA  ,IB  )
  305.       REL(IA   ,IB+18)=-REL(IA  ,IB  )
  306.       REL(IA+18,IB   )=-REL(IA  ,IB  )
  307. C
  308.       REL(IA+12,IB+12)= REL(IA+6,IB+6)
  309.       REL(IA+6 ,IB+12)=-REL(IA+6,IB+6)
  310.       REL(IA+12,IB+6 )=-REL(IA+6,IB+6)
  311. C
  312.       REL(IA+12,IB+18)= REL(IA+6,IB  )
  313.       REL(IA+18,IB+12)= REL(IA+6,IB  )
  314. C
  315.       REL(IA   ,IB+12)=-REL(IA+6,IB  )
  316.       REL(IA+12,IB   )=-REL(IA+6,IB  )
  317. C
  318.       REL(IA+18,IB+6 )=-REL(IA+6,IB  )
  319.       REL(IA+6 ,IB+18)=-REL(IA+6,IB  )
  320. C
  321.  900  CONTINUE
  322. C
  323. C      CHANGEMENT DU REPERE    EN FONCTION DE BPSS
  324. C
  325.       CALL TRANSK(REL,BPSS,24,4,IZERO)
  326. C
  327.   666 CONTINUE
  328.       RETURN
  329.       END
  330.  
  331.  

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