1 : C DYNE14 SOURCE CHAT 06/03/29 21:19:09 5360 2 : SUBROUTINE DYNE14(ITREFR,KTLIAB) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *--------------------------------------------------------------------* 6 : * * 7 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 8 : * ________________________________________________ * 9 : * * 10 : * Remplissage du tableau contenant les paramètres de liaison en * 11 : * cas de reprise. * 12 : * * 13 : * Paramètres: * 14 : * * 15 : * IPALB Renseigne sur la liaison. * 16 : * XPALB Tableau contenant les paramètres de la liaison. * 17 : * NLIAB Nombre de liaisons sur la base B. * 18 : * IDIM Nombre de directions. * 19 : * * 20 : * * 21 : * Auteur, date de création: * 22 : * * 23 : * Bertrand BEAUFILS : le 31 juillet 1990 * 24 : * Ibrahim Pinto, 05/97 , liaisons segment_cercle * 25 : *--------------------------------------------------------------------* 26 : * 27 : -INC CCOPTIO 28 : -INC SMCOORD 29 : -INC SMLENTI 30 : * 31 : 32 : 33 : LOGICAL L0,L1 34 : SEGMENT,MTLIAB 35 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 36 : REAL*8 XPALB(NLIAB,NXPALB) 37 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 38 : ENDSEGMENT 39 : * 40 : 41 : 42 : MTLIAB = KTLIAB 43 : NLIAB = XPALB(/1) 44 : * 45 : * Boucle sur le nombre de liaisons 46 : * 47 : ID0 = 0 48 : ID1 = 0 49 : ID2 = 0 50 : DO 10 I = 1,NLIAB 51 : ITYP = IPALB(I,1) 51 : CALL ACCTAB(ITREFR,'ENTIER',I,X0,' ',L0,IP0, 52 : & 'TABLE',I1,X1,' ',L1,ITREFI) 53 : IF (IERR.NE.0) RETURN 53 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0, 54 : & 'ENTIER',ITYPR,X1,' ',L1,ITR) 55 : IF (IERR.NE.0) RETURN 56 : IF (ITYP.NE.ITYPR) THEN 56 : call erreur(21) 57 : RETURN 58 : ENDIF 59 : * 60 : * ------ choc élémentaire POINT ou POINT_CERCLE_MOBILE 61 : * sans amortissement 62 : * 63 : IF (ITYP.EQ.23. OR. ITYP.EQ.33) THEN 64 : IDIM = IPALB(I,3) 65 : ID0 = 6 + 6*IDIM 66 : ID1 = 6 + 7*IDIM 67 : ID2 = 6 + 8*IDIM 68 : 69 : * 70 : * ------ choc élémentaire POINT ou POINT_CERCLE_MOBILE 71 : * avec amortissement 72 : * 73 : ELSE IF (ITYP.EQ.24 .OR. ITYP.EQ.34) THEN 74 : IDIM = IPALB(I,3) 75 : ID0 = 7 + 6*IDIM 76 : ID1 = 7 + 7*IDIM 77 : ID2 = 7 + 8*IDIM 78 : * 79 : * ------ choc élémentaire CERCLE_PLAN_FROTTEMENT 80 : ELSE IF (ITYP.EQ.5) THEN 81 : IDIM = IPALB(I,3) 82 : ID0 = 6 + 4*IDIM 83 : ID1 = 6 + 5*IDIM 84 : ID2 = 6 + 6*IDIM 85 : * 86 : * ------ choc élémentaire POINT_PLAN_FROTTEMENT, 87 : * POINT_POINT_FROTTEMENT et autres liaisons... 88 : * 89 : ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.6 .or. ityp .eq. 13 .or. 90 : & ITYP.EQ.103 .OR. ITYP.EQ.113) THEN 91 : IDIM = IPALB(I,3) 92 : ID0 = 7 + 4*IDIM 93 : ID1 = 7 + 5*IDIM 94 : ID2 = 7 + 6*IDIM 95 : 96 : * 97 : * ------ choc élémentaire CERCLE_CERCLE_FROTTEMENT 98 : * 99 : ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN 100 : IF (ITYP.EQ.23) THEN 101 : IDD = 6 102 : ELSE 103 : IDD = 7 104 : ENDIF 105 : IDIM = IPALB(I,3) 106 : ID0 = IDD + 6*IDIM 107 : ID1 = IDD + 7*IDIM 108 : ID2 = IDD + 8*IDIM 109 : ID3 = IDD + 2*IDIM 110 : 110 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE', 111 : & L0,IP0,'POINT',I1,X1,' ',L1,IPOR0) 112 : IF (IERR.NE.0) RETURN 113 : IPN0 = (IDIM + 1) * (IPOR0 - 1) 114 : 114 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0, 115 : & 'POINT',I1,X1,' ',L1,IPOR1) 116 : IF (IERR.NE.0) RETURN 117 : IPN1 = (IDIM + 1) * (IPOR1 - 1) 118 : 119 : 119 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE', 120 : & L0,IP0,'POINT',I1,X1,' ',L1,IPOR2) 121 : IF (IERR.NE.0) RETURN 122 : IPN2 = (IDIM + 1) * (IPOR2 - 1) 123 : 123 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'NORMALE_DE_CHOC', 124 : & L0,IP0,'POINT',I1,X1,' ',L1,IPOR3) 125 : IF (IERR.NE.0) RETURN 126 : IPN3 = (IDIM + 1) * (IPOR3 - 1) 127 : 128 : DO 40 ID = 1,IDIM 129 : XPALB(I,ID0+ID) = XCOOR(IPN0 + ID) 130 : XPALB(I,ID1+ID) = XCOOR(IPN1 + ID) 131 : XPALB(I,ID2+ID) = XCOOR(IPN2 + ID) 132 : XPALB(I,ID3+ID) = XCOOR(IPN3 + ID) 133 : 40 CONTINUE 134 : * end do 135 : 135 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0, 136 : & 'ENTIER',IGP,X1,' ',L1,IRP) 137 : IF (IERR.NE.0) RETURN 138 : IPALB(I,2) = IGP 139 : * 140 : GOTO 10 141 : 142 : * 143 : * 144 : * 145 : * ------ CHOC éLéMENTAIRE POINT_PLAN_FLUIDE 146 : * 147 : ELSE IF (ITYP.EQ.7) THEN 148 : IDIM = IPALB(I,3) 149 : ID1 = 6 + IDIM 149 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_1/2',L0,IP0, 150 : & 'POINT',I1,X1,' ',L1,IPDEP) 151 : IF (IERR.NE.0) RETURN 151 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_1/2',L0,IP0, 152 : & 'POINT',I1,X1,' ',L1,IPVIT) 153 : IF (IERR.NE.0) RETURN 153 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'ACCELERATION_1/2',L0,IP0, 154 : & 'POINT',I1,X1,' ',L1,IPACC) 155 : IF (IERR.NE.0) RETURN 156 : IPND = (IDIM + 1) * (IPDEP - 1) 157 : IPNV = (IDIM + 1) * (IPVIT - 1) 158 : IPNA = (IDIM + 1) * (IPACC - 1) 159 : XPALB(I,ID1+1) = XCOOR(IPND + 1) 160 : XPALB(I,ID1+2) = XCOOR(IPNV + 1) 161 : XPALB(I,ID1+3) = XCOOR(IPNA + 1) 162 : GOTO 10 163 : ** ianis 164 : * 165 : * ------ choc élémentaire POINT_PLAN avec plasticite 166 : * 167 : ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101 ) THEN 168 : C chargement du deplacement plastique 168 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE', 169 : & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2) 170 : IF (IERR.NE.0) RETURN 171 : IDIM = IPALB(I,3) 172 : id1 = 4 173 : XPALB(I,(ID1+IDIM+1)) = XDPLAS 174 : GOTO 10 175 : * 176 : * ------ choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE 177 : * 178 : ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN 179 : C chargement du deplacement plastique et de la limite elastique 179 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE', 180 : & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2) 181 : IF (IERR.NE.0) RETURN 182 : * 183 : * le depl limite elastique ne sert plus a rien 183 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_LIMITE_ELASTIQUE', 184 : & L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2) 185 : IF (IERR.NE.0) RETURN 185 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE_CUMULE', 186 : & L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2) 187 : IF (IERR.NE.0) RETURN 188 : idim = IPALB(I,3) 189 : if (ityp.eq.16) nn = 4 + idim 190 : if (ityp.eq.17) nn = 5 + idim 191 : XPALB(I,nn-2) = XDPLAS 192 : XPALB(I,nn-1) = XELA 193 : XPALB(I,nn) = XDPLAC 194 : GOTO 10 195 : * 196 : * ------ choc elementaire POINT_POINT_ROTATION_PLASTIQUE 197 : * 198 : ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN 199 : * chargement de la rotation plastique et de la limite elastique 199 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE', 200 : & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2) 201 : IF (IERR.NE.0) RETURN 202 : * 203 : * la rot limite elastique ne sert plus a rien 203 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_LIMITE_ELASTIQUE', 204 : & L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2) 205 : IF (IERR.NE.0) RETURN 205 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE_CUMULE', 206 : & L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2) 207 : IF (IERR.NE.0) RETURN 208 : idim = IPALB(I,3) 209 : if (ityp.eq.50) nn = 4 + idim 210 : if (ityp.eq.51) nn = 5 + idim 211 : XPALB(I,nn-2) = XDPLAS 212 : XPALB(I,nn-1) = XELA 213 : XPALB(I,nn) = XDPLAC 214 : 215 : GOTO 10 216 : C 217 : * -------choc élémentaire LIGNE_LIGNE_FROTTEMENT 218 : * 219 : ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN 220 : * Chargement des noeudS leS plus proche 220 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0, 221 : & 'LISTENTI',I1,X1,' ',L1,IVOIS1) 222 : IF (IERR.NE.0) RETURN 223 : MLENTI = IVOIS1 224 : SEGACT,MLENTI 225 : NNOE=LECT(/1) 226 : DO 30 JVOI=1,NNOE 227 : IPALB(I,26+JVOI)=LECT(JVOI) 228 : 30 CONTINUE 229 : SEGSUP,MLENTI 230 : 231 : 232 : * -------chocS élémentaireS SEGMENT_CERCLE_FROTTEMENT_sanreac ET ..._REACNOR 233 : * 234 : ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38 235 : & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN 236 : * Chargement des noeudS leS plus proche 236 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0, 237 : & 'LISTENTI',I1,X1,' ',L1,IVOIS1) 238 : IF (IERR.NE.0) RETURN 239 : MLENTI = IVOIS1 240 : SEGACT,MLENTI 241 : NNOE=LECT(/1) 242 : DO 32 JVOI=1,NNOE 243 : IPALB(I,26+JVOI)=LECT(JVOI) 244 : 32 CONTINUE 245 : SEGSUP,MLENTI 246 : 247 : 248 : 249 : 250 : * 251 : * 252 : * 253 : * ------ choc .... 254 : * 255 : * ELSE IF (ITYP.EQ. ) THEN 256 : * ... 257 : * 258 : * 259 : ELSE 260 : GOTO 10 261 : ENDIF 262 : * 263 : IF (ITYP.NE.35 .AND. ITYP.NE.36 .AND. ITYP.NE.37 264 : & .AND. ITYP.NE.38 .AND. ITYP.NE.39 .AND. ITYP.NE.40) THEN 265 : * 266 : * Chargement de la position origine d'adhérence 267 : * 267 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE', 268 : & L0,IP0,'POINT',I1,X1,' ',L1,IPOR0) 269 : IF (IERR.NE.0) RETURN 270 : IPN0 = (IDIM + 1) * (IPOR0 - 1) 271 : * 272 : * Chargement de la vitesse tangentielle 273 : * 273 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0, 274 : & 'POINT',I1,X1,' ',L1,IPOR1) 275 : IF (IERR.NE.0) RETURN 276 : IPN1 = (IDIM + 1) * (IPOR1 - 1) 277 : * 278 : * Chargement de la force tangentielle 279 : * 279 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE', 280 : & L0,IP0,'POINT',I1,X1,' ',L1,IPOR2) 281 : IF (IERR.NE.0) RETURN 282 : IPN2 = (IDIM + 1) * (IPOR2 - 1) 283 : DO 20 ID = 1,IDIM 284 : XPALB(I,ID0+ID) = XCOOR(IPN0 + ID) 285 : XPALB(I,ID1+ID) = XCOOR(IPN1 + ID) 286 : XPALB(I,ID2+ID) = XCOOR(IPN2 + ID) 287 : 20 CONTINUE 288 : * end do 289 : ENDIF 290 : * 291 : * Chargement de l'état tangentiel de la liaison 292 : * 292 : CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0, 293 : & 'ENTIER',IGP,X1,' ',L1,IRP) 294 : IF (IERR.NE.0) RETURN 295 : IPALB(I,2) = IGP 296 : * 297 : 10 CONTINUE 298 : 299 : 300 : * end do 301 : * 302 : END 303 : 304 : 305 : 306 : 307 : 308 : 309 : 310 : 311 : 312 : 313 :
© Cast3M 2003 - All rights reserved.
Disclaimer