1 : C LISPR3 SOURCE CHAT 05/01/13 01:23:34 5004 2 : SUBROUTINE LISPR3(XE,EPA1,FISS1,V1,EPA2,FISS2,V2,D,XEL,BPSS, 3 : 1 REL,I70,I343,I157,I158) 4 : C======================================================================= 5 : C 6 : C EBERSOLT MARS 85 7 : C ENTREES 8 : C XE(3,4) = COORDONNEES DE LA POUTRE LINESPRING 9 : C EPA1 = EPAISSEUR NOEUDS 1 4 10 : C EPA2 = EPAISSEUR NOEUDS 2 3 11 : C FISS1 = PROFONDEUR DE LA FISSURE NOEUDS 1 4 12 : C FISS2 = PROFONDEUR DE LA FISSURE NOEUDS 2 3 13 : C V1(3) = VECTEUR ORIENTANT LES NOEUDS 1 4 14 : C V2(3) = VECTEUR ORIENTANT LES NOEUDS 2 3 15 : C D(2,2) = MATRICE DE HOOKE 16 : C TABLEAU DE TRAVAIL 17 : C XEL(3,3) = COORDONNEES LOCALES 18 : C BPSS(3,3) = MATRICE DE PASSAGE 19 : C SORTIES 20 : C REL(24,24) = MATRICE DE RIGIDITE AXES GLOBAUX 21 : C I70 = INDICERNABILITE DES 2 LEVRES 22 : C I343 = PROFONDEUR DE FISSURE NEGATIVE 23 : C I157 = LES 2 LEVRES SONT TROP ELOIGNEES 24 : C I158 = FISSURE TOTALEMENT TRAVERSANTE RIGIDITE NULLE 25 : C 26 : C======================================================================= 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8(A-H,O-Z) 29 : PARAMETER ( PENA = 1.D6,PENB = 1.D2 ) 30 : PARAMETER ( EPS = 1.D-3,EPSINV = 1.D-3) 31 : PARAMETER ( XZER=0.D0,UNDEMI=.5D0,DEUX=2.D0,SIX=6.D0) 32 : PARAMETER ( QUATRE=4.D0,DOUZE=12.D0,TRSIX=36.D0) 33 : PARAMETER ( NPOINT=3,IZERO=0) 34 : PARAMETER ( X774=.774596669241483D0) 35 : 36 : DIMENSION XE(3,*),D(2,*),REL(24,*),V1(*),V2(*),BPSS(3,*),XEL(3,*) 37 : DIMENSION S(3),POIDS(3) 38 : C 39 : C 40 : S(1)=-X774 41 : S(2)= XZER 42 : S(3)= X774 43 : POIDS(1)=5.D0/9.D0 44 : POIDS(2)=8.D0/9.D0 45 : POIDS(3)=5.D0/9.D0 46 : C 47 : C LES FISS1 ET FISS2 QUE L ON RECUPERE SONT AUX POINTS DE GAUSS 48 : C IL FAUT LES CALCULER AUX EXTREMITES 49 : C 50 : FIS10 = (FISS1*(UNDEMI +UNDEMI/X774))+(FISS2*(UNDEMI-UNDEMI/X774)) 51 : FIS20 = (FISS1*(UNDEMI -UNDEMI/X774))+(FISS2*(UNDEMI+UNDEMI/X774)) 52 : C 53 : C MISE A XZER DE LA RIGIDITE ET DES INDICATEURS D ERREUR 54 : C 54 : CALL ZERO(REL,24,24) 55 : I70 =0 56 : I343=0 57 : I157=0 58 : I158=0 59 : C 60 : IF(FIS10.LT.XZER) THEN 61 : I343=1 62 : FIS10=XZER 63 : ENDIF 64 : C 65 : IF(FIS20.LT.XZER) THEN 66 : I343=1 67 : FIS20=XZER 68 : ENDIF 69 : C 70 : C EXTRACTION DE LA MATRICE DE PASSAGE 71 : C 72 : DO 100 IA=1,3 73 : XEL(IA,1)=XE(IA,1) 74 : XEL(IA,2)=XE(IA,2) 75 : XEL(IA,3)=XE(IA,1)+(V1(IA)+V2(IA))*UNDEMI 76 : 100 CONTINUE 76 : CALL VPAST(XEL,BPSS) 77 : DJA1=XZER 78 : DJA2=XZER 79 : DO 105 IA=1,3 80 : DJA1=DJA1+(XE(IA,1)-XE(IA,4))*BPSS(3,IA) 81 : DJA2=DJA2+(XE(IA,2)-XE(IA,3))*BPSS(3,IA) 82 : 105 CONTINUE 83 : DJAC=DJA1*DJA2 84 : IF(DJAC.LT.0.) I195=1 85 : C 86 : C HAUT = LARGEUR ENTRE LES NOEUDS 1,4 ET 2,3 87 : C 88 : HAUT=XZER 89 : XLARG1=XZER 90 : XLARG2=XZER 91 : DO 110 IA=1,3 92 : HAUT =(XE(IA,2)-XE(IA,1))*(XE(IA,2)-XE(IA,1))+HAUT 93 : XLARG1=(XE(IA,4)-XE(IA,1))*(XE(IA,4)-XE(IA,1))+XLARG1 94 : XLARG2=(XE(IA,3)-XE(IA,2))*(XE(IA,3)-XE(IA,2))+XLARG2 95 : 110 CONTINUE 96 : HAUT =SQRT(HAUT) 97 : XLARG1=SQRT(XLARG1) 98 : XLARG2=SQRT(XLARG2) 99 : EPS1=XLARG1/HAUT 100 : EPS2=XLARG2/HAUT 101 : IF(EPS1.GT.EPS.OR.EPS2.GT.EPS) I157=1 102 : DJA1=DJA1/HAUT 103 : DJA2=DJA2/HAUT 104 : IF(DJA1.LT.1.D-3.AND.DJA2.LT.1.D-3) I70=1 105 : C 106 : C ASURW = A / W NOTATION CHEISSOUX 107 : C 108 : W=(EPA1+EPA2)*UNDEMI 109 : ASURW=(FIS10+FIS20)/W 110 : ASUR1=FIS10/W 111 : ASUR2=FIS20/W 112 : IF(ASUR1.GT..98.AND.ASUR2.GT..98) I158=1 113 : IF(I158.EQ.1) GOTO 666 114 : C 115 : C PENALISATION NORMALE 116 : C 117 : PEWM=D(1,1)*W*PENA*HAUT/SIX 118 : PEWF=PEWM*W*W/DOUZE 119 : PEWM2=DEUX*PEWM 120 : PEWF2=DEUX*PEWF 121 : C 122 : C PENALISATION SOUS INTEGRE 123 : C 124 : PEWM15=D(1,1)*W*PENB*HAUT/QUATRE 125 : PEWF15=PEWM15*W*W/DOUZE 126 : C 127 : C PENALISATION SI ELEMENT EXTREME 128 : C 129 : PEWMEX=D(1,1)*W*PENA*HAUT*UNDEMI 130 : PEWFEX=PEWMEX*W*W/DOUZE 131 : C 132 : C PENALISATION DES TERMES CONCERNANT K I SI FISSURE INEXISTANTE 133 : C 134 : IF(ASURW.GT.EPSINV) GOTO 366 135 : REL(3 ,3 )=PEWM2 136 : REL(4 ,4 )=PEWF2 137 : REL(9 ,9 )=PEWM2 138 : REL(10,10)=PEWF2 139 : REL(3 ,9 )=PEWM 140 : REL(9 ,3 )=PEWM 141 : REL(4 ,10)=PEWF 142 : REL(10,4 )=PEWF 143 : GOTO 466 144 : 366 CONTINUE 145 : C 146 : C INTEGRATION NORMALE 147 : C 148 : X1=XZER 149 : X2=XZER 150 : X3=XZER 151 : X4=XZER 152 : X5=XZER 153 : X6=XZER 154 : X7=XZER 155 : X8=XZER 156 : X9=XZER 157 : DO 500 IA=1,NPOINT 158 : H1=UNDEMI-UNDEMI*S(IA) 159 : H2=UNDEMI+UNDEMI*S(IA) 160 : ASURW=H1*ASUR1+H2*ASUR2 160 : CALL LISPAL(ASURW,ALMM,ALMF,ALFF,DELTA) 161 : DELTA=POIDS(IA)*D(1,1)*HAUT*UNDEMI/DELTA 162 : C 163 : X1=X1+H1*H1*DELTA*ALFF 164 : X2=X2-H1*H1*DELTA*ALMF*W/SIX 165 : X3=X3+H1*H1*DELTA*ALMM*W*W/TRSIX 166 : C 167 : X4=X4+H1*H2*DELTA*ALFF 168 : X5=X5-H1*H2*DELTA*ALMF*W/SIX 169 : X6=X6+H1*H2*DELTA*ALMM*W*W/TRSIX 170 : C 171 : X7=X7+H2*H2*DELTA*ALFF 172 : X8=X8-H2*H2*DELTA*ALMF*W/SIX 173 : X9=X9+H2*H2*DELTA*ALMM*W*W/TRSIX 174 : 500 CONTINUE 175 : C 176 : C MISE EN PLACE DANS LA MATRICE DE RIGIDITE 177 : C 178 : REL(3 ,3 )=X1 179 : REL(3 ,4 )=X2 180 : REL(4 ,3 )=X2 181 : REL(4 ,4 )=X3 182 : C 183 : REL(9 ,3 )=X4 184 : REL(9 ,4 )=X5 185 : REL(10,3 )=X5 186 : REL(10,4 )=X6 187 : C 188 : REL(3 ,9 )=X4 189 : REL(3 ,10)=X5 190 : REL(4 ,9 )=X5 191 : REL(4 ,10)=X6 192 : C 193 : REL(9 ,9 )=X7 194 : REL(9 ,10)=X8 195 : REL(10,9 )=X8 196 : REL(10,10)=X9 197 : C 198 : C PENALISATION DES TERMES NE CONCERNANT PAS K I 199 : C 200 : 466 CONTINUE 201 : C 202 : REL(1 ,1 )=PEWM15 203 : REL(2 ,2 )=PEWM15 204 : REL(6 ,6 )=PEWF15 205 : C 206 : REL(7 ,7 )=PEWM15 207 : REL(8 ,8 )=PEWM15 208 : REL(12,12)=PEWF15 209 : C 210 : REL(1 ,7 )=PEWM15 211 : REL(7 ,1 )=PEWM15 212 : REL(2 ,8 )=PEWM15 213 : REL(8 ,2 )=PEWM15 214 : REL(6 ,12)=PEWF15 215 : REL(12,6 )=PEWF15 216 : C 217 : C DOUBLE SYMETRISATION A PARTIR D UNE MATRICE 12 12 ON A UNE 24 24 218 : C 219 : DO 900 IA=1,6 220 : DO 900 IB=1,6 221 : C 222 : REL(IA+18,IB+18)= REL(IA ,IB ) 223 : REL(IA ,IB+18)=-REL(IA ,IB ) 224 : REL(IA+18,IB )=-REL(IA ,IB ) 225 : C 226 : REL(IA+12,IB+12)= REL(IA+6,IB+6) 227 : REL(IA+6 ,IB+12)=-REL(IA+6,IB+6) 228 : REL(IA+12,IB+6 )=-REL(IA+6,IB+6) 229 : C 230 : REL(IA+12,IB+18)= REL(IA+6,IB ) 231 : REL(IA+18,IB+12)= REL(IA+6,IB ) 232 : C 233 : REL(IA ,IB+12)=-REL(IA+6,IB ) 234 : REL(IA+12,IB )=-REL(IA+6,IB ) 235 : C 236 : REL(IA+18,IB+6 )=-REL(IA+6,IB ) 237 : REL(IA+6 ,IB+18)=-REL(IA+6,IB ) 238 : C 239 : 900 CONTINUE 240 : C 241 : C CHANGEMENT DU REPERE EN FONCTION DE BPSS 242 : C 242 : CALL TRANSK(REL,BPSS,24,4,IZERO) 243 : C 244 : 666 CONTINUE 245 : RETURN 246 : END 247 :
© Cast3M 2003 - All rights reserved.
Disclaimer