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----------------------------------------------- 90 : CALL VPAST(XEL,BPSS) 90 : CALL MATVEC(XDDL,XDDLOC,BPSS,8) 91 : C----------------------------------------------- 92 : C système local: x,y et z 93 : C Noeud 1 (_NO1): 94 : C XNO1=(XE(1,1)*BPSS(1,1))+(XE(2,1)*BPSS(1,2))+(XE(3,1)*BPSS(1,3)) 95 : C YNO1=(XE(1,1)*BPSS(2,1))+(XE(2,1)*BPSS(2,2))+(XE(3,1)*BPSS(2,3)) 96 : C ZNO1=(XE(1,1)*BPSS(3,1))+(XE(2,1)*BPSS(3,2))+(XE(3,1)*BPSS(3,3)) 97 : C Noeud2 (_NO2): 98 : C XNO2=(XE(1,2)*BPSS(1,1))+(XE(2,2)*BPSS(1,2))+(XE(3,2)*BPSS(1,3)) 99 : C YNO2=(XE(1,2)*BPSS(2,1))+(XE(2,2)*BPSS(2,2))+(XE(3,2)*BPSS(2,3)) 100 : ZNO2=(XE(1,2)*BPSS(3,1))+(XE(2,2)*BPSS(3,2))+(XE(3,2)*BPSS(3,3)) 101 : C Noeud 3 (_NO3): 102 : C XNO3=(XE(1,3)*BPSS(1,1))+(XE(2,3)*BPSS(1,2))+(XE(3,3)*BPSS(1,3)) 103 : C YNO3=(XE(1,3)*BPSS(2,1))+(XE(2,3)*BPSS(2,2))+(XE(3,3)*BPSS(2,3)) 104 : ZNO3=(XE(1,3)*BPSS(3,1))+(XE(2,3)*BPSS(3,2))+(XE(3,3)*BPSS(3,3)) 105 : C 106 : C Direction z: Différence entre noeud 2 et noeud 3: 107 : DZ23 = ZNO2 - ZNO3 108 : C ________________________________________________________________ 109 : C 110 : DJA1=XZERO 111 : DJA2=XZERO 112 : DO 105 IA=1,3 113 : DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA) 114 : DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA) 115 : 105 CONTINUE 116 : DJAC=DJA1*DJA2 117 : IF(DJAC.LT.-1.D-20) I195=1 118 : C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3 C HAUT 119 : C = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3 120 : HAUT=XZERO 121 : XLARG1=XZERO 122 : XLARG2=XZERO 123 : DO 110 IA=1,3 124 : HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT 125 : XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1 126 : XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2 127 : 110 CONTINUE 128 : HAUT =SQRT(HAUT) 129 : XLARG1=SQRT(XLARG1) 130 : XLARG2=SQRT(XLARG2) 131 : EPS1=XLARG1/HAUT 132 : EPS2=XLARG2/HAUT 133 : IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1 134 : DJA1=DJA1/HAUT 135 : DJA2=DJA2/HAUT 136 : IF(DJA1.LT.1.D-6.AND.DJA2.LT.1.D-6) I70=1 137 : C 138 : C ASURW = A / W NOTATION CHEISSOUX 139 : C 140 : W=(EPA1+EPA2)*UNDEMI 141 : ASURW=(FISS1+FISS2)/W 142 : ASUR1=FISS1/W 143 : ASUR2=FISS2/W 144 : IF(ASUR1.GT..98D0.AND.ASUR2.GT..98D0) I69=1 145 : IF(I69.EQ.1) GOTO 666 146 : C 147 : C TRANSFORMATION DE D 148 : D(1,1)=D(1,1)*W 149 : D(2,2)=D(2,2)*W*W*W/DOUZE 150 : C 151 : PEWM=D(1,1)*PENA 152 : PEWF=D(2,2)*PENA 153 : PEWMB=D(1,1)*PENB 154 : PEWFB=D(2,2)*PENA 155 : IF (ASURW.GT.EPSINV) THEN 156 : C 157 : C BOUCLE SUR LES POINTS DE CONTRAINTES 158 : C 159 : DO 200 IA=1,NPOINT 160 : H1=UNDEMI-UNDEMI*S(IA) 161 : H2=UNDEMI+UNDEMI*S(IA) 162 : ASURW=(H1*FISS1+H2*FISS2)/W 163 : A = H1*FISS1+H2*FISS2 164 : C 165 : C ON RECUPERE LES COEFFICIENTS ALPHAS ET F I 166 : C-------------------------------------------------- 166 : CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA) 166 : CALL LISPFI(ASURW,FM,FF) 166 : C CALL INTER2D 167 : C-------------------------------------------------- 168 : DELTA=D(1,1)/DELTA 169 : C 170 : C CALCUL DES COEFFICIENTS R1 R2 R3 R4 171 : C 172 : R1= DELTA*ALFF/W 173 : R2=-DELTA*ALMF/SIX 174 : R3=-DELTA*ALMF/SIX 175 : R4= DELTA*ALMM*W/TRSIX 176 : C 177 : C REMPLISSAGE DES CONTRAINTES 178 : C 179 : IF (DZ23.GE.0) THEN 180 : EPXZ=(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13)) 181 : $ *H2 182 : EPYZ=(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14)) 183 : $ *H2 184 : DD =(XDDLOC(3 )-XDDLOC(21))*H1+(XDDLOC(9 )-XDDLOC(15)) 185 : $ *H2 186 : RT =(XDDLOC(4 )-XDDLOC(22))*H1+(XDDLOC(10)-XDDLOC(16)) 187 : $ *H2 188 : RTZZ=(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18)) 189 : $ *H2 190 : ELSE 191 : EPXZ=(XDDLOC(19)-XDDLOC(1 ))*H1+(XDDLOC(13)-XDDLOC(7 )) 192 : $ *H2 193 : EPYZ=(XDDLOC(20)-XDDLOC(2 ))*H1+(XDDLOC(14)-XDDLOC(8 )) 194 : $ *H2 195 : DD =(XDDLOC(21)-XDDLOC(3 ))*H1+(XDDLOC(15)-XDDLOC(9 )) 196 : $ *H2 197 : RT =(XDDLOC(22)-XDDLOC(4 ))*H1+(XDDLOC(16)-XDDLOC(10)) 198 : $ *H2 199 : RTZZ=(XDDLOC(24)-XDDLOC(6 ))*H1+(XDDLOC(18)-XDDLOC(12)) 200 : $ *H2 201 : ENDIF 202 : C ___________________________________________________________ 203 : C 204 : IX=6*(IA-1) 205 : C 206 : XSTRS(IX+1)=DD*R1+RT*R2 207 : XSTRS(IX+2)=PEWMB*EPXZ 208 : XSTRS(IX+3)=PEWMB*EPYZ 209 : XSTRS(IX+4)=DD*R3+RT*R4 210 : XSTRS(IX+5)=PEWFB*RTZZ 211 : C 212 : X1=XSTRS(IX+1)/W 213 : X4=XSTRS(IX+4)*SIX/(W*W) 214 : C ________________________________________ 215 : C 216 : C CALCUL DE K I ET DE J 217 : C 218 : XXX=XPI*A 219 : XXX=SQRT(XXX) 220 : XKIE =(X1*FM+X4*FF)*XXX 221 : XSTRS(IX+6)= XKIE 222 : C 223 : 200 CONTINUE 224 : C 225 : C SI FISSURE INEXISTANTE 226 : C 227 : C ON FAIT UN C.S.T. POUR L ELEMENT DU BOUT 228 : C 229 : ELSE IF(ASURW.LE.EPSINV) THEN 230 : C 231 : DO 150 IA=1,NPOINT 232 : H1=UNDEMI-UNDEMI*S(IA) 233 : H2=UNDEMI+UNDEMI*S(IA) 234 : EPXZ =(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))*H2 235 : EPYZ =(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))*H2 236 : C 237 : DD1 = XDDLOC(3 )-XDDLOC(21) 238 : DD2 = XDDLOC(9 )-XDDLOC(15) 239 : DD = DD1*H1 + DD2*H2 240 : C 241 : RT1 = XDDLOC(4 )-XDDLOC(22) 242 : RT2 = XDDLOC(10)-XDDLOC(16) 243 : RT = RT1*H1 + RT2*H2 244 : C 245 : RTZZ =(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))*H2 246 : IX=6*(IA-1) 247 : XSTRS(IX+1)=PEWM*DD 248 : XSTRS(IX+2)=PEWMB*EPXZ 249 : XSTRS(IX+3)=PEWMB*EPYZ 250 : XSTRS(IX+4)=PEWF*RT 251 : XSTRS(IX+5)=PEWFB*RTZZ 252 : XSTRS(IX+6)=XZERO 253 : 150 CONTINUE 254 : ENDIF 255 : 666 CONTINUE 256 : RETURN 257 : END 258 : 259 : 260 : 261 : 262 :
© Cast3M 2003 - All rights reserved.
Disclaimer