1 : C DEVLB2 SOURCE CHAT 05/01/12 22:46:19 5004 2 : SUBROUTINE DEVLB2(IPLIB,IPALB,XPALB,XPTB,NLIAB,IND,IDIMB, 3 : & NPLB,XABSCI,XORDON,NIP) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Initialisation du tableau contenant les paramètres de liaison * 12 : * * 13 : * Paramètres: * 14 : * * 15 : * e IPALB Renseigne sur la liaison. * 16 : * e XPALB Tableau contenant les paramètres de la liaison. * 17 : * e NLIAB Nombre de liaisons sur la base B. * 18 : * e IDIMB Nombre de directions. * 19 : * e IND Indice du pas. * 20 : * * 21 : * * 22 : * Auteur, date de création: * 23 : * * 24 : * Bertrand BEAUFILS : le 27 juillet 1990 * 25 : * Ibrahim Pinto, 05/97 , liaisons ligne_cercle * 26 : *--------------------------------------------------------------------* 27 : * 28 : 29 : 30 : INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*) 31 : REAL*8 XPALB(NLIAB,*),XPTB(NPLB,4,*),XPTP2(3) 32 : REAL*8 XABSCI(NLIAB,*),XORDON(NLIAB,*) 33 : * 34 : 35 : 36 : IND2 = IND + 1 37 : * 38 : * Boucle sur le nombre de liaisons 39 : * 40 : DO 10 I = 1,NLIAB 41 : ITYP = IPALB(I,1) 42 : * 43 : * ------ choc élémentaire POINT_CERCLE_FROTTEMENT 44 : * 45 : IF (ITYP.EQ.23 .OR. ITYP.EQ.24) THEN 46 : NPOI = IPLIB(I,1) 47 : IDIM = IPALB(I,3) 48 : IF (ITYP.EQ.23) THEN 49 : ID1 = 6 50 : ELSE 51 : ID1 = 7 52 : ENDIF 53 : ID7 = ID1 + 6*IDIM 54 : DO 230 ID=1,IDIM 55 : * déjà effectué dans devcoi , avec prise en compte de 56 : * la rotation initiale 57 : * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID) 58 : XPALB(I,ID7+ID) = XPTB(NPOI,IND,ID) 59 : 230 CONTINUE 60 : * end do 61 : 62 : 63 : * 64 : * ------ choc élémentaire POINT_CERCLE_MOBILE 65 : * 66 : ELSE IF (ITYP.EQ.33 .OR. ITYP.EQ.34) THEN 67 : NPOA = IPLIB(I,1) 68 : NPOB = IPLIB(I,2) 69 : IDIM = IPALB(I,3) 70 : IF (ITYP.EQ.33) THEN 71 : ID1 = 6 72 : ELSE 73 : ID1 = 7 74 : ENDIF 75 : ID7 = ID1 + 6*IDIM 76 : DO 330 ID=1,IDIM 77 : * XPTB(NPOa,IND2,ID) = XPTB(NPOa,IND,ID) 78 : * XPTB(NPOb,IND2,ID) = XPTB(NPOb,IND,ID) 79 : XPALB(I,ID7+ID) = XPTB(NPOa,IND,ID) 80 : & - XPTB(NPOb,IND,ID) 81 : 330 CONTINUE 82 : 83 : * 84 : * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT 85 : * 86 : ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN 87 : NPOI = IPLIB(I,1) 88 : IDIM = IPALB(I,3) 89 : IF (ITYP.EQ.25) THEN 90 : ID1 = 6 91 : ELSE 92 : ID1 = 7 93 : ENDIF 94 : ID2 = ID1 + IDIM 95 : ID3 = ID1 + 2*IDIM 96 : ID7 = ID1 + 6*IDIM 97 : ID10 = ID1 + 9*IDIM 98 : XRAYT = XPALB(I,ID10+1) 99 : * Calcul du déplacement du point fibre neutre dans le plan du cercle 100 : * Calcul de la normale de choc 101 : PSXPN = 0.D0 102 : DO 250 ID = 1,IDIM 103 : PSXPN = PSXPN + ( XPTB(NPOI,IND,ID) * XPALB(I,ID1+ID) ) 104 : 250 CONTINUE 105 : * end do 106 : PSXPME = 0.D0 107 : DO 252 ID = 1,IDIM 108 : XXPME = ( XPTB(NPOI,IND,ID) - ( PSXPN * XPALB(I,ID1+ID) ) ) 109 : & - XPALB(I,ID2+ID) 110 : XPALB(I,ID3+ID) = XXPME 111 : PSXPME = PSXPME + ( XXPME * XXPME ) 112 : 252 CONTINUE 113 : * end do 114 : PSXPME = SQRT(PSXPME) 115 : IF (PSXPME.GT.1D-20) THEN 116 : DO 254 ID = 1,IDIM 117 : XPALB(I,ID3+ID) = XPALB(I,ID3+ID) / PSXPME 118 : 254 CONTINUE 119 : * end do 120 : ENDIF 121 : * Calcul du déplacement du point de contact au pas courant 122 : XPTP2(1) = XPTB(NPOI,IND,1) + 123 : & ( XPALB(I,ID3+1) * XRAYT ) 124 : XPTP2(2) = XPTB(NPOI,IND,2) + 125 : & ( XPALB(I,ID3+2) * XRAYT ) 126 : XPTP2(3) = XPTB(NPOI,IND,3) + 127 : & ( XPALB(I,ID3+3) * XRAYT ) 128 : * Initialisation de la position origine adherence 129 : DO 256 ID=1,IDIM 130 : * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID) 131 : XPALB(I,ID7+ID) = XPTP2(ID) 132 : 256 CONTINUE 133 : * end do 134 : * 135 : * ------ choc élémentaire POINT_POINT_FROTTEMENT 136 : * 137 : ELSE IF ((abs(ITYP)).EQ.13 .or.ityp.eq.113) THEN 138 : NPOa = IPLIB(I,1) 139 : NPOb = IPLIB(I,2) 140 : IDIM = IPALB(I,3) 141 : ID1 = 7 142 : ID5 = ID1 + 4*IDIM 143 : DO 31 ID=1,IDIM 144 : * XPTB(NPOa,IND2,ID) = XPTB(NPOa,IND,ID) 145 : * XPTB(NPOb,IND2,ID) = XPTB(NPOb,IND,ID) 146 : XPALB(I,ID5+ID) = XPTB(NPOa,IND,ID) 147 : & - XPTB(NPOb,IND,ID) 148 : 31 CONTINUE 149 : * 150 : * ------ choc élémentaire POINT_PLAN_FROTTEMENT 151 : * 152 : ELSE IF (ITYP.EQ.3 ) THEN 153 : NPOI = IPLIB(I,1) 154 : IDIM = IPALB(I,3) 155 : ID1 = 7 156 : ID5 = ID1 + 4*IDIM 157 : DO 30 ID=1,IDIM 158 : * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID) 159 : XPALB(I,ID5+ID) = XPTB(NPOI,IND,ID) 160 : 30 CONTINUE 161 : * end do 162 : * 163 : * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT 164 : * 165 : ELSE IF (ITYP.EQ.5 .OR. ITYP.EQ.6) THEN 166 : NPOI = IPLIB(I,1) 167 : IDIM = IPALB(I,3) 168 : IF (ITYP.EQ.5) THEN 169 : ID1 = 6 170 : ELSE 171 : ID1 = 7 172 : ENDIF 173 : ID5 = ID1 + 4*IDIM 174 : ID8 = ID1 + 7*IDIM 175 : XRAYT = XPALB(I,ID8+1) 176 : * calcul du déplacement du point de contact au pas courant 177 : XPTP2(1) = XPTB(NPOI,IND,1) + 178 : & ( ( XPTB(NPOI,IND,5) * XPALB(I,ID1+3) * XRAYT ) - 179 : & ( XPTB(NPOI,IND,6) * XPALB(I,ID1+2) * XRAYT ) ) 180 : XPTP2(2) = XPTB(NPOI,IND,2) + 181 : & ( ( XPTB(NPOI,IND,6) * XPALB(I,ID1+1) * XRAYT ) - 182 : & ( XPTB(NPOI,IND,4) * XPALB(I,ID1+3) * XRAYT ) ) 183 : XPTP2(3) = XPTB(NPOI,IND,3) + 184 : & ( ( XPTB(NPOI,IND,4) * XPALB(I,ID1+2) * XRAYT ) - 185 : & ( XPTB(NPOI,IND,5) * XPALB(I,ID1+1) * XRAYT ) ) 186 : DO 50 ID = 1,IDIM 187 : * XPTB(NPOI,IND2,ID) = XPTB(NPOI,IND,ID) 188 : XPALB(I,ID5+ID) = XPTP2(ID) 189 : 50 CONTINUE 190 : * end do 191 : * 192 : * ------ choc élémentaire POINT_PLAN_FLUIDE 193 : * 194 : ELSE IF (ITYP.EQ.7) THEN 195 : IDIM = IPALB(I,3) 196 : ID1 = 6 + IDIM 197 : XPALB(I,ID1+1) = 0.D0 198 : XPALB(I,ID1+2) = 0.D0 199 : XPALB(I,ID1+3) = 0.D0 200 : 201 : ** ianis 202 : ELSE IF (ITYP.EQ.100) THEN 203 : XPALB(I,(5 + IDIMB)) = 0.D0 204 : * 205 : * ------ choc elementaire POINT_POINT_ ... _PLASTIQUE 206 : * 207 : ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.50) THEN 208 : IDIM = IPALB(I,3) 209 : XPALB(I,2+IDIM) = 0.D0 210 : XPALB(I,3+IDIM) = XABSCI(I,2) 211 : XPALB(I,4+IDIM) = 0.D0 212 : * 213 : ELSE IF (ITYP.EQ.17 .OR. ITYP.EQ.51) THEN 214 : IDIM = IPALB(I,3) 215 : XPALB(I,3+IDIM) = 0.D0 216 : XPALB(I,4+IDIM) = XABSCI(I,2) 217 : XPALB(I,5+IDIM) = 0.D0 218 : * 219 : * ------ choc élémentaire LIGNE_LIGNE_FROTTEMENT 220 : * 221 : ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN 222 : NNOEMA = IPALB(I,21) 223 : NNOEES = IPALB(I,22) 224 : * Initialisation de la recherche du noeud maitre voisin 225 : IGLOBA = 1 226 : DO 340 INOE=1,NNOEES 226 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, 227 : & NPLB,IGLOBA,0) 228 : 340 CONTINUE 229 : DO 342 INOE=1,NNOEMA 229 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, 230 : & NPLB,IGLOBA,1) 231 : 342 CONTINUE 232 : 233 : 234 : 235 : 236 : * 237 : * ------ choc élémentaire LIGNE_CERCLE 238 : * 239 : 240 : 241 : 242 : ELSE IF (ITYP.EQ.37.OR.ITYP.EQ.38 243 : & .OR. ITYP.EQ.39.OR.ITYP.EQ.40) THEN 244 : NNOEMA = IPALB(I,21) 245 : NNOEES = IPALB(I,22) 246 : * Initialisation de la recherche du noeud maitre voisin 247 : IGLOBA = 1 248 : DO 440 INOE=1,NNOEES 248 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, 249 : & NPLB,IGLOBA,0) 250 : 440 CONTINUE 251 : DO 442 INOE=1,NNOEMA 251 : CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB, 252 : & NPLB,IGLOBA,1) 253 : 442 CONTINUE 254 : 255 : 256 : 257 : 258 : * ------ choc ........... 259 : * 260 : * ELSE IF (ITYP.EQ. ) THEN 261 : * ....... 262 : * ....... 263 : * 264 : ENDIF 265 : 10 CONTINUE 266 : 267 : * end do 268 : * 269 : END 270 : 271 : 272 : 273 : 274 : 275 : 276 : 277 : 278 :
© Cast3M 2003 - All rights reserved.
Disclaimer