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 58 : CALL ZERO(REL,24,24) 59 : I70 =0 60 : I343=0 61 : I157=0 62 : I158=0 63 : C 64 : IF(XCAR(2).LT.XZER) THEN 65 : I343=1 66 : FIS10=XZER 67 : ELSE 68 : FIS10=XCAR(2) 69 : ENDIF 70 : C 71 : IF(XCAR(12).LT.XZER) THEN 72 : I343=1 73 : FIS30=XZER 74 : ELSE 75 : FIS30=XCAR(12) 76 : ENDIF 77 : C 78 : C EXTRACTION DE LA MATRICE DE PASSAGE 79 : C 80 : DO 100 IA=1,3 81 : XEL(IA,1)=XE(IA,1) 82 : XEL(IA,2)=XE(IA,2) 83 : XEL(IA,3)=XE(IA,1)+V1(IA) 84 : 100 CONTINUE 84 : CALL VPAST(XEL,BPSS) 85 : DJA1=XZER 86 : DJA2=XZER 87 : DO 105 IA=1,3 88 : DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA) 89 : DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA) 90 : 105 CONTINUE 91 : DJAC=DJA1*DJA2 92 : IF(DJAC.LT.0.) I195=1 93 : C 94 : C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3 95 : C 96 : HAUT=XZER 97 : XLARG1=XZER 98 : XLARG2=XZER 99 : DO 110 IA=1,3 100 : HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT 101 : XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1 102 : XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2 103 : 110 CONTINUE 104 : HAUT =SQRT(HAUT) 105 : XLARG1=SQRT(XLARG1) 106 : XLARG2=SQRT(XLARG2) 107 : EPS1=XLARG1/HAUT 108 : EPS2=XLARG2/HAUT 109 : IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1 110 : DJA1=DJA1/HAUT 111 : DJA2=DJA2/HAUT 112 : IF(DJA1.LT.1.D-3.AND.DJA2.LT.1.D-3) I70=1 113 : ASUR1=FIS10/EPAI 114 : ASUR3=FIS30/EPAI 115 : ASUR0=(FIS10 + FIS30 ) / EPAI 116 : IF(ASUR1.GT..98.AND.ASUR3.GT..98) I158=1 117 : IF(I158.EQ.1) GOTO 666 118 : C 119 : C ON RECUPERE LES VALEURS DU MODULE D YOUNG 120 : C 121 : YOU = XMAT(1) 122 : XNU = XMAT(2) 123 : SIGY= XMAT(5) 124 : C 125 : C PENALISATION NORMALE 126 : C 127 : DDD = YOU * UNDEMI / ( UN - XNU * XNU ) 128 : PEWM=DDD *EPAI*PENA*HAUT/SIX 129 : PEWF=PEWM*EPAI*EPAI/DOUZE 130 : PEWM2=DEUX*PEWM 131 : PEWF2=DEUX*PEWF 132 : C 133 : C PENALISATION SOUS INTEGRE 134 : C 135 : PEWM15=DDD*EPAI*PENB*HAUT/QUATRE 136 : PEWF15=PEWM15*EPAI*EPAI/DOUZE 137 : C 138 : C PENALISATION DES TERMES CONCERNANT K I SI FISSURE INEXISTANTE 139 : C 140 : IF(ASUR0.GT.EPSINV) GOTO 366 141 : REL(3 ,3 )=PEWM2 142 : REL(4 ,4 )=PEWF2 143 : REL(9 ,9 )=PEWM2 144 : REL(10,10)=PEWF2 145 : REL(3 ,9 )=PEWM 146 : REL(9 ,3 )=PEWM 147 : REL(10,4 )=PEWF 148 : REL(4 ,10)=PEWF 149 : GOTO 466 150 : 366 CONTINUE 151 : C 152 : C INTEGRATION NORMALE 153 : C 154 : X1=XZER 155 : X2=XZER 156 : X3=XZER 157 : X4=XZER 158 : X5=XZER 159 : X6=XZER 160 : X7=XZER 161 : X8=XZER 162 : X9=XZER 163 : DO 500 IA=1,NPOINT 164 : H1=UNDEMI-UNDEMI*S(IA) 165 : H2=UNDEMI+UNDEMI*S(IA) 166 : NCC = ( IA - 1 ) * 5 167 : NSS = ( IA - 1 ) * NSTRS 168 : NVV = ( IA - 1 ) * 2 169 : NMM = ( IA - 1 ) * 5 170 : C 171 : ASURW=XCAR(NCC+2)/EPAI 172 : YOU = XMAT(NMM+1) 173 : XNU = XMAT(NMM+2) 174 : SIGY= XMAT(NMM+5) 175 : IF(SIGY.LE.XZER) KERRE=30 176 : DDD = YOU * UNDEMI / ( UN - XNU * XNU ) 176 : CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA) 177 : DELTA=POIDS(IA)*DDD*HAUT*UNDEMI/DELTA 178 : C 179 : D11 = DELTA * ALFF 180 : D12 = DELTA * ALMF * EPAI / SIX 181 : D21 = DELTA * ALMF * EPAI / SIX 182 : D22 = DELTA * ALMM * EPAI * EPAI / TRSIX 183 : C 184 : C CALCUL DES DERIVEES 185 : C 186 : IF(SIGY.EQ.XZER) GOTO 111 186 : CALL LISPPA(ASURW,EPAI,SIGY,GA,GB,A,B,C,D,E,F) 187 : XN = XSTRS(NSS+1) 188 : XM = XSTRS(NSS+4) 189 : C 190 : C VERIFICATION A L INTERIEUR DE LA SURFACE DE CHARGE OU PAS 191 : C 191 : CALL LISPQ(XN,XM,EPAI,SIGY,GA,GB,ASURW,Q) 192 : IF(VAR(NVV+1).EQ.XZER.AND.Q.LE.XZER) THEN 193 : ILOPL=0 194 : ELSE IF(VAR(NVV+1).EQ.XZER.AND.Q.GT.XZER) THEN 195 : ILOPL=-1 196 : ILO11=-1 197 : ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.LT.XPRECM) THEN 198 : ILOPL=0 199 : ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.GE.XPRECM.AND.Q.LE.XPRECP) THEN 200 : ILOPL=1 201 : ELSE IF(VAR(NVV+1).GT.XZER.AND.Q.GT.XPRECP) THEN 202 : ILOPL=-1 203 : ILO11=-1 204 : ENDIF 205 : C 206 : C MATRICE DE RAIDEUR OU MATRICE TANGENTE 207 : C 208 : IF(ILOPL.EQ.1) THEN 209 : DFIDN = A * XN + B * XM + E 210 : DFIDM = B * XN + D * XM + F 211 : U = D11 * DFIDN + D12 * DFIDM 212 : V = D21 * DFIDN + D22 * DFIDM 213 : C 214 : DENOM = U * DFIDN + V * DFIDM 215 : D11 = D11 - U * U / DENOM 216 : D12 = D12 - U * V / DENOM 217 : D21 = D21 - V * U / DENOM 218 : D22 = D22 - V * V / DENOM 219 : ENDIF 220 : 111 CONTINUE 221 : C 222 : X1=X1+H1*H1*D11 223 : X2=X2-H1*H1*D12 224 : X3=X3+H1*H1*D22 225 : C 226 : X4=X4+H1*H2*D11 227 : X5=X5-H1*H2*D12 228 : X6=X6+H1*H2*D22 229 : C 230 : X7=X7+H2*H2*D11 231 : X8=X8-H2*H2*D12 232 : X9=X9+H2*H2*D22 233 : 500 CONTINUE 234 : C 235 : C MISE EN PLACE DANS LA MATRICE DE RIGIDITE 236 : C 237 : REL(3 ,3 )=X1 238 : REL(3 ,4 )=X2 239 : REL(4 ,3 )=X2 240 : REL(4 ,4 )=X3 241 : C 242 : REL(9 ,3 )=X4 243 : REL(9 ,4 )=X5 244 : REL(10,3 )=X5 245 : REL(10,4 )=X6 246 : C 247 : REL(3 ,9 )=X4 248 : REL(3 ,10)=X5 249 : REL(4 ,9 )=X5 250 : REL(4 ,10)=X6 251 : C 252 : REL(9 ,9 )=X7 253 : REL(9 ,10)=X8 254 : REL(10,9 )=X8 255 : REL(10,10)=X9 256 : C 257 : C PENALISATION DES TERMES NE CONCERNANT PAS K I 258 : C 259 : 466 CONTINUE 260 : C 261 : IF(MELE.EQ.30) THEN 262 : REL(1 ,1 )=PEWM2 263 : REL(2 ,2 )=PEWM2 264 : REL(6 ,6 )=PEWF2 265 : C 266 : REL(7 ,7 )=PEWM2 267 : REL(8 ,8 )=PEWM2 268 : REL(12,12)=PEWF2 269 : C 270 : REL(1 ,7 )=PEWM 271 : REL(7 ,1 )=PEWM 272 : REL(2 ,8 )=PEWM 273 : REL(8 ,2 )=PEWM 274 : REL(6 ,12)=PEWF 275 : REL(12,6 )=PEWF 276 : C 277 : ELSE IF(MELE.EQ.50) THEN 278 : REL(1 ,1 )=PEWM15 279 : REL(2 ,2 )=PEWM15 280 : REL(6 ,6 )=PEWF15 281 : C 282 : REL(7 ,7 )=PEWM15 283 : REL(8 ,8 )=PEWM15 284 : REL(12,12)=PEWF15 285 : C 286 : REL(1 ,7 )=PEWM15 287 : REL(7 ,1 )=PEWM15 288 : REL(2 ,8 )=PEWM15 289 : REL(8 ,2 )=PEWM15 290 : REL(6 ,12)=PEWF15 291 : REL(12,6 )=PEWF15 292 : ENDIF 293 : C 294 : C DOUBLE SYMETRISATION A PARTIR D UNE MATRICE 12 12 ON A UNE 24 24 295 : C 296 : DO 900 IA=1,6 297 : DO 900 IB=1,6 298 : C 299 : REL(IA+18,IB+18)= REL(IA ,IB ) 300 : REL(IA ,IB+18)=-REL(IA ,IB ) 301 : REL(IA+18,IB )=-REL(IA ,IB ) 302 : C 303 : REL(IA+12,IB+12)= REL(IA+6,IB+6) 304 : REL(IA+6 ,IB+12)=-REL(IA+6,IB+6) 305 : REL(IA+12,IB+6 )=-REL(IA+6,IB+6) 306 : C 307 : REL(IA+12,IB+18)= REL(IA+6,IB ) 308 : REL(IA+18,IB+12)= REL(IA+6,IB ) 309 : C 310 : REL(IA ,IB+12)=-REL(IA+6,IB ) 311 : REL(IA+12,IB )=-REL(IA+6,IB ) 312 : C 313 : REL(IA+18,IB+6 )=-REL(IA+6,IB ) 314 : REL(IA+6 ,IB+18)=-REL(IA+6,IB ) 315 : C 316 : 900 CONTINUE 317 : C 318 : C CHANGEMENT DU REPERE EN FONCTION DE BPSS 319 : C 319 : CALL TRANSK(REL,BPSS,24,4,IZERO) 320 : C 321 : 666 CONTINUE 322 : RETURN 323 : END 324 :
© Cast3M 2003 - All rights reserved.
Disclaimer