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