C LISPR3 SOURCE CHAT 05/01/13 01:23:34 5004 SUBROUTINE LISPR3(XE,EPA1,FISS1,V1,EPA2,FISS2,V2,D,XEL,BPSS, 1 REL,I70,I343,I157,I158) C======================================================================= C C EBERSOLT MARS 85 C ENTREES C XE(3,4) = COORDONNEES DE LA POUTRE LINESPRING C EPA1 = EPAISSEUR NOEUDS 1 4 C EPA2 = EPAISSEUR NOEUDS 2 3 C FISS1 = PROFONDEUR DE LA FISSURE NOEUDS 1 4 C FISS2 = PROFONDEUR DE LA FISSURE NOEUDS 2 3 C V1(3) = VECTEUR ORIENTANT LES NOEUDS 1 4 C V2(3) = VECTEUR ORIENTANT LES NOEUDS 2 3 C D(2,2) = MATRICE DE HOOKE C TABLEAU DE TRAVAIL C XEL(3,3) = COORDONNEES LOCALES C BPSS(3,3) = MATRICE DE PASSAGE C SORTIES C REL(24,24) = MATRICE DE RIGIDITE AXES GLOBAUX C I70 = INDICERNABILITE DES 2 LEVRES C I343 = PROFONDEUR DE FISSURE NEGATIVE C I157 = LES 2 LEVRES SONT TROP ELOIGNEES C I158 = FISSURE TOTALEMENT TRAVERSANTE RIGIDITE NULLE C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) PARAMETER ( PENA = 1.D6,PENB = 1.D2 ) PARAMETER ( EPS = 1.D-3,EPSINV = 1.D-3) PARAMETER ( XZER=0.D0,UNDEMI=.5D0,DEUX=2.D0,SIX=6.D0) PARAMETER ( QUATRE=4.D0,DOUZE=12.D0,TRSIX=36.D0) PARAMETER ( NPOINT=3,IZERO=0) PARAMETER ( X774=.774596669241483D0) DIMENSION XE(3,*),D(2,*),REL(24,*),V1(*),V2(*),BPSS(3,*),XEL(3,*) DIMENSION S(3),POIDS(3) C C S(1)=-X774 S(2)= XZER S(3)= X774 POIDS(1)=5.D0/9.D0 POIDS(2)=8.D0/9.D0 POIDS(3)=5.D0/9.D0 C C LES FISS1 ET FISS2 QUE L ON RECUPERE SONT AUX POINTS DE GAUSS C IL FAUT LES CALCULER AUX EXTREMITES C FIS10 = (FISS1*(UNDEMI +UNDEMI/X774))+(FISS2*(UNDEMI-UNDEMI/X774)) FIS20 = (FISS1*(UNDEMI -UNDEMI/X774))+(FISS2*(UNDEMI+UNDEMI/X774)) C C MISE A XZER DE LA RIGIDITE ET DES INDICATEURS D ERREUR C CALL ZERO(REL,24,24) I70 =0 I343=0 I157=0 I158=0 C IF(FIS10.LT.XZER) THEN I343=1 FIS10=XZER ENDIF C IF(FIS20.LT.XZER) THEN I343=1 FIS20=XZER ENDIF C C EXTRACTION DE LA MATRICE DE PASSAGE C DO 100 IA=1,3 XEL(IA,1)=XE(IA,1) XEL(IA,2)=XE(IA,2) XEL(IA,3)=XE(IA,1)+(V1(IA)+V2(IA))*UNDEMI 100 CONTINUE CALL VPAST(XEL,BPSS) DJA1=XZER DJA2=XZER DO 105 IA=1,3 DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA) DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA) 105 CONTINUE DJAC=DJA1*DJA2 IF(DJAC.LT.0.) I195=1 C C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3 C HAUT=XZER XLARG1=XZER XLARG2=XZER DO 110 IA=1,3 HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1 XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2 110 CONTINUE HAUT =SQRT(HAUT) XLARG1=SQRT(XLARG1) XLARG2=SQRT(XLARG2) EPS1=XLARG1/HAUT EPS2=XLARG2/HAUT IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1 DJA1=DJA1/HAUT DJA2=DJA2/HAUT IF(DJA1.LT.1.D-3.AND.DJA2.LT.1.D-3) I70=1 C C ASURW = A / W NOTATION CHEISSOUX C W=(EPA1+EPA2)*UNDEMI ASURW=(FIS10+FIS20)/W ASUR1=FIS10/W ASUR2=FIS20/W IF(ASUR1.GT..98.AND.ASUR2.GT..98) I158=1 IF(I158.EQ.1) GOTO 666 C C PENALISATION NORMALE C PEWM=D(1,1)*W*PENA*HAUT/SIX PEWF=PEWM*W*W/DOUZE PEWM2=DEUX*PEWM PEWF2=DEUX*PEWF C C PENALISATION SOUS INTEGRE C PEWM15=D(1,1)*W*PENB*HAUT/QUATRE PEWF15=PEWM15*W*W/DOUZE C C PENALISATION SI ELEMENT EXTREME C PEWMEX=D(1,1)*W*PENA*HAUT*UNDEMI PEWFEX=PEWMEX*W*W/DOUZE C C PENALISATION DES TERMES CONCERNANT K I SI FISSURE INEXISTANTE C IF(ASURW.GT.EPSINV) GOTO 366 REL(3 ,3 )=PEWM2 REL(4 ,4 )=PEWF2 REL(9 ,9 )=PEWM2 REL(10,10)=PEWF2 REL(3 ,9 )=PEWM REL(9 ,3 )=PEWM REL(4 ,10)=PEWF REL(10,4 )=PEWF GOTO 466 366 CONTINUE C C INTEGRATION NORMALE C X1=XZER X2=XZER X3=XZER X4=XZER X5=XZER X6=XZER X7=XZER X8=XZER X9=XZER DO 500 IA=1,NPOINT H1=UNDEMI-UNDEMI*S(IA) H2=UNDEMI+UNDEMI*S(IA) ASURW=H1*ASUR1+H2*ASUR2 CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA) DELTA=POIDS(IA)*D(1,1)*HAUT*UNDEMI/DELTA C X1=X1+H1*H1*DELTA*ALFF X2=X2-H1*H1*DELTA*ALMF*W/SIX X3=X3+H1*H1*DELTA*ALMM*W*W/TRSIX C X4=X4+H1*H2*DELTA*ALFF X5=X5-H1*H2*DELTA*ALMF*W/SIX X6=X6+H1*H2*DELTA*ALMM*W*W/TRSIX C X7=X7+H2*H2*DELTA*ALFF X8=X8-H2*H2*DELTA*ALMF*W/SIX X9=X9+H2*H2*DELTA*ALMM*W*W/TRSIX 500 CONTINUE C C MISE EN PLACE DANS LA MATRICE DE RIGIDITE C REL(3 ,3 )=X1 REL(3 ,4 )=X2 REL(4 ,3 )=X2 REL(4 ,4 )=X3 C REL(9 ,3 )=X4 REL(9 ,4 )=X5 REL(10,3 )=X5 REL(10,4 )=X6 C REL(3 ,9 )=X4 REL(3 ,10)=X5 REL(4 ,9 )=X5 REL(4 ,10)=X6 C REL(9 ,9 )=X7 REL(9 ,10)=X8 REL(10,9 )=X8 REL(10,10)=X9 C C PENALISATION DES TERMES NE CONCERNANT PAS K I C 466 CONTINUE C REL(1 ,1 )=PEWM15 REL(2 ,2 )=PEWM15 REL(6 ,6 )=PEWF15 C REL(7 ,7 )=PEWM15 REL(8 ,8 )=PEWM15 REL(12,12)=PEWF15 C REL(1 ,7 )=PEWM15 REL(7 ,1 )=PEWM15 REL(2 ,8 )=PEWM15 REL(8 ,2 )=PEWM15 REL(6 ,12)=PEWF15 REL(12,6 )=PEWF15 C C DOUBLE SYMETRISATION A PARTIR D UNE MATRICE 12 12 ON A UNE 24 24 C DO 900 IA=1,6 DO 900 IB=1,6 C REL(IA+18,IB+18)= REL(IA ,IB ) REL(IA ,IB+18)=-REL(IA ,IB ) REL(IA+18,IB )=-REL(IA ,IB ) C REL(IA+12,IB+12)= REL(IA+6,IB+6) REL(IA+6 ,IB+12)=-REL(IA+6,IB+6) REL(IA+12,IB+6 )=-REL(IA+6,IB+6) C REL(IA+12,IB+18)= REL(IA+6,IB ) REL(IA+18,IB+12)= REL(IA+6,IB ) C REL(IA ,IB+12)=-REL(IA+6,IB ) REL(IA+12,IB )=-REL(IA+6,IB ) C REL(IA+18,IB+6 )=-REL(IA+6,IB ) REL(IA+6 ,IB+18)=-REL(IA+6,IB ) C 900 CONTINUE C C CHANGEMENT DU REPERE EN FONCTION DE BPSS C CALL TRANSK(REL,BPSS,24,4,IZERO) C 666 CONTINUE RETURN END