1 : C LISPS2 SOURCE CHAT 05/01/13 01:23:42 5004 2 : SUBROUTINE LISPS2(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 MARS 85 7 : C UHLMANN OCTOBRE 94 8 : C 9 : 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.D6) 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 119 : HAUT=XZERO 120 : XLARG1=XZERO 121 : XLARG2=XZERO 122 : DO 110 IA=1,3 123 : HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT 124 : XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1 125 : XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2 126 : 110 CONTINUE 127 : HAUT =SQRT(HAUT) 128 : XLARG1=SQRT(XLARG1) 129 : XLARG2=SQRT(XLARG2) 130 : EPS1=XLARG1/HAUT 131 : EPS2=XLARG2/HAUT 132 : IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1 133 : DJA1=DJA1/HAUT 134 : DJA2=DJA2/HAUT 135 : IF(DJA1.LT.1.D-6.AND.DJA2.LT.1.D-6) I70=1 136 : C 137 : C ASURW = A/W NOTATION CHEISSOUX 138 : C 139 : W=(EPA1+EPA2)*UNDEMI 140 : ASURW=(FISS1+FISS2)/W 141 : ASUR1=FISS1/W 142 : ASUR2=FISS2/W 143 : IF(ASUR1.GT..98D0.AND.ASUR2.GT..98D0) I69=1 144 : IF(I69.EQ.1) GOTO 666 145 : C 146 : C TRANSFORMATION DE D: 147 : D(1,1)=D(1,1)*W 148 : D(2,2)=D(2,2)*W*W*W/DOUZE 149 : C 150 : PEWM=D(1,1)*PENA 151 : PEWF=D(2,2)*PENA 152 : PEWMB=D(1,1)*PENB 153 : PEWFB=D(2,2)*PENA 154 : IF (ASURW.GT.EPSINV) THEN 155 : C 156 : C BOUCLE SUR LES POINTS DE CONTRAINTES 157 : C 158 : DO 200 IA=1,NPOINT 159 : H1=UNDEMI-UNDEMI*S(IA) 160 : H2=UNDEMI+UNDEMI*S(IA) 161 : ASURW=(H1*FISS1+H2*FISS2)/W 162 : A = H1*FISS1+H2*FISS2 163 : C 164 : C ON RECUPERE LES COEFFICIENTS ALPHAS ET F I 165 : C-------------------------------------------------- 165 : CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA) 165 : CALL LISPFI(ASURW,FM,FF) 165 : C CALL INTER2D 166 : C-------------------------------------------------- 167 : DELTA=D(1,1)/DELTA 168 : C 169 : C CALCUL DES COEFFICIENTS R1 R2 R3 R4 170 : C 171 : R1= DELTA*ALFF/W 172 : R2=-DELTA*ALMF/SIX 173 : R3=-DELTA*ALMF/SIX 174 : R4= DELTA*ALMM*W/TRSIX 175 : C 176 : C REMPLISSAGE DES CONTRAINTES: 177 : C 178 : IF (DZ23.GE.0) THEN 179 : EPXZ=(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13)) 180 : $ *H2 181 : EPYZ=(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14)) 182 : $ *H2 183 : DD =(XDDLOC(3 )-XDDLOC(21))*H1+(XDDLOC(9 )-XDDLOC(15)) 184 : $ *H2 185 : RT =(XDDLOC(4 )-XDDLOC(22))*H1+(XDDLOC(10)-XDDLOC(16)) 186 : $ *H2 187 : RTZZ=(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18)) 188 : $ *H2 189 : ELSE 190 : EPXZ=(XDDLOC(19)-XDDLOC(1 ))*H1+(XDDLOC(13)-XDDLOC(7 )) 191 : $ *H2 192 : EPYZ=(XDDLOC(20)-XDDLOC(2 ))*H1+(XDDLOC(14)-XDDLOC(8 )) 193 : $ *H2 194 : DD =(XDDLOC(21)-XDDLOC(3 ))*H1+(XDDLOC(15)-XDDLOC(9 )) 195 : $ *H2 196 : RT =(XDDLOC(22)-XDDLOC(4 ))*H1+(XDDLOC(16)-XDDLOC(10)) 197 : $ *H2 198 : RTZZ=(XDDLOC(24)-XDDLOC(6 ))*H1+(XDDLOC(18)-XDDLOC(12)) 199 : $ *H2 200 : ENDIF 201 : C __________________________________________________________ 202 : C 203 : IX=6*(IA-1) 204 : C 205 : XSTRS(IX+1)=DD*R1+RT*R2 206 : XSTRS(IX+2)=PEWMB*EPXZ 207 : XSTRS(IX+3)=PEWMB*EPYZ 208 : XSTRS(IX+4)=DD*R3+RT*R4 209 : XSTRS(IX+5)=PEWFB*RTZZ 210 : C 211 : X1=XSTRS(IX+1)/W 212 : X4=XSTRS(IX+4)*SIX/(W*W) 213 : C ________________________________________ 214 : C 215 : C CALCUL DE K I ET DE J 216 : C 217 : XXX=XPI*A 218 : XXX=SQRT(XXX) 219 : XKIE =(X1*FM+X4*FF)*XXX 220 : XSTRS(IX+6)= XKIE 221 : C 222 : 200 CONTINUE 223 : C 224 : C SI FISSURE INEXISTANTE 225 : C 226 : C ON FAIT UN C.S.T. POUR L ELEMENT DU BOUT 227 : C 228 : ELSE IF(ASURW.LE.EPSINV) THEN 229 : C 230 : DO 150 IA=1,NPOINT 231 : H1=UNDEMI-UNDEMI*S(IA) 232 : H2=UNDEMI+UNDEMI*S(IA) 233 : EPXZ =(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))*H2 234 : EPYZ =(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))*H2 235 : C 236 : DD1 = XDDLOC(3 )-XDDLOC(21) 237 : DD2 = XDDLOC(9 )-XDDLOC(15) 238 : DD = DD1*H1 + DD2*H2 239 : C 240 : RT1 = XDDLOC(4 )-XDDLOC(22) 241 : RT2 = XDDLOC(10)-XDDLOC(16) 242 : RT = RT1*H1 + RT2*H2 243 : C 244 : RTZZ =(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))*H2 245 : IX=6*(IA-1) 246 : XSTRS(IX+1)=PEWM*DD 247 : XSTRS(IX+2)=PEWMB*EPXZ 248 : XSTRS(IX+3)=PEWMB*EPYZ 249 : XSTRS(IX+4)=PEWF*RT 250 : XSTRS(IX+5)=PEWFB*RTZZ 251 : XSTRS(IX+6)=XZERO 252 : 150 CONTINUE 253 : ENDIF 254 : 666 CONTINUE 255 : RETURN 256 : END 257 : 258 : 259 : 260 : 261 :
© Cast3M 2003 - All rights reserved.
Disclaimer