C DYNE14 SOURCE BP208322 20/03/26 21:15:53 10562 SUBROUTINE DYNE14(ITREFR,KTLIAB) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : * * Remplissage du tableau contenant les paramètres de liaison en * * cas de reprise. * * * *--------------------------------------------------------------------* * * * Paramètres: * * * * e IPALB Renseigne sur la liaison. * * e/s XPALB Tableau contenant les paramètres de la liaison. * * e NLIAB Nombre de liaisons sur la base B. * * e IDIM Nombre de directions. * * * *--------------------------------------------------------------------* * -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMLENTI LOGICAL L0,L1 SEGMENT,MTLIAB INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) REAL*8 XPALB(NLIAB,NXPALB) REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) ENDSEGMENT MTLIAB = KTLIAB NLIAB = XPALB(/1) * *--------------------------------------------------------------------* * Boucle sur les liaisons *--------------------------------------------------------------------* * ID0 = 0 ID1 = 0 ID2 = 0 DO 10 I = 1,NLIAB ITYP = IPALB(I,1) CALL ACCTAB(ITREFR,'ENTIER',I,X0,' ',L0,IP0, & 'TABLE',I1,X1,' ',L1,ITREFI) IF (IERR.NE.0) RETURN CALL ACCTAB(ITREFI,'MOT',I0,X0,'TYPE',L0,IP0, & 'ENTIER',ITYPR,X1,' ',L1,ITR) IF (IERR.NE.0) RETURN IF (ITYP.NE.ITYPR) THEN call erreur(21) RETURN ENDIF * * ------ choc elementaire POINT_CERCLE_MOBILE * sans amortissement * cbp,2020 IF (ITYP.EQ.23. OR. ITYP.EQ.33) THEN IF (ITYP.EQ.33) THEN IDIM = IPALB(I,3) ID0 = 6 + 6*IDIM ID1 = 6 + 7*IDIM ID2 = 6 + 8*IDIM * * ------ choc elementaire POINT_CERCLE_FROTTEMENT * ELSE IF (ITYP.EQ.23) THEN IDIM = IPALB(I,3) ID0 = 10 + 6*IDIM ID1 = 10 + 7*IDIM ID2 = 10 + 8*IDIM * * ------ choc elementaire POINT_CERCLE_MOBILE * avec amortissement * cbp,2020 ELSE IF (ITYP.EQ.24 .OR. ITYP.EQ.34) THEN ELSE IF (ITYP.EQ.34) THEN IDIM = IPALB(I,3) ID0 = 7 + 6*IDIM ID1 = 7 + 7*IDIM ID2 = 7 + 8*IDIM * * ------ choc elementaire CERCLE_PLAN_FROTTEMENT ELSE IF (ITYP.EQ.5) THEN IDIM = IPALB(I,3) ID0 = 6 + 4*IDIM ID1 = 6 + 5*IDIM ID2 = 6 + 6*IDIM * * ------ choc elementaire POINT_PLAN_FROTTEMENT * ELSE IF (ITYP.EQ.3 .OR. ITYP.EQ.103 ) THEN IDIM = IPALB(I,3) cbp,2020 ID0 = 7 + 4*IDIM cbp,2020 ID1 = 7 + 5*IDIM cbp,2020 ID2 = 7 + 6*IDIM ID0 = 9 + 5*IDIM ID1 = 9 + 6*IDIM ID2 = 9 + 7*IDIM * * ------ choc elementaire POINT_POINT_FROTTEMENT * et CERCLE_PLAN_FROTTEMENT avec amortissement * ELSE IF (ITYP.EQ.13 .OR. ITYP.EQ.113 .OR. ITYP.EQ.6) THEN IDIM = IPALB(I,3) ID0 = 7 + 4*IDIM ID1 = 7 + 5*IDIM ID2 = 7 + 6*IDIM * * ------ choc elementaire CERCLE_CERCLE_FROTTEMENT * ELSE IF (ITYP.EQ.25 .OR. ITYP.EQ.26) THEN IF (ITYP.EQ.23) THEN IDD = 6 ELSE IDD = 7 ENDIF IDIM = IPALB(I,3) ID0 = IDD + 6*IDIM ID1 = IDD + 7*IDIM ID2 = IDD + 8*IDIM ID3 = IDD + 2*IDIM CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE', & L0,IP0,'POINT',I1,X1,' ',L1,IPOR0) IF (IERR.NE.0) RETURN IPN0 = (IDIM + 1) * (IPOR0 - 1) CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0, & 'POINT',I1,X1,' ',L1,IPOR1) IF (IERR.NE.0) RETURN IPN1 = (IDIM + 1) * (IPOR1 - 1) CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE', & L0,IP0,'POINT',I1,X1,' ',L1,IPOR2) IF (IERR.NE.0) RETURN IPN2 = (IDIM + 1) * (IPOR2 - 1) CALL ACCTAB(ITREFI,'MOT',I0,X0,'NORMALE_DE_CHOC', & L0,IP0,'POINT',I1,X1,' ',L1,IPOR3) IF (IERR.NE.0) RETURN IPN3 = (IDIM + 1) * (IPOR3 - 1) DO 40 ID = 1,IDIM XPALB(I,ID0+ID) = XCOOR(IPN0 + ID) XPALB(I,ID1+ID) = XCOOR(IPN1 + ID) XPALB(I,ID2+ID) = XCOOR(IPN2 + ID) XPALB(I,ID3+ID) = XCOOR(IPN3 + ID) 40 CONTINUE * end do CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0, & 'ENTIER',IGP,X1,' ',L1,IRP) IF (IERR.NE.0) RETURN IPALB(I,2) = IGP * GOTO 10 * * * * ------ choc elementaire POINT_PLAN_FLUIDE * ELSE IF (ITYP.EQ.7) THEN IDIM = IPALB(I,3) ID1 = 6 + IDIM CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_1/2',L0,IP0, & 'POINT',I1,X1,' ',L1,IPDEP) IF (IERR.NE.0) RETURN CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_1/2',L0,IP0, & 'POINT',I1,X1,' ',L1,IPVIT) IF (IERR.NE.0) RETURN CALL ACCTAB(ITREFI,'MOT',I0,X0,'ACCELERATION_1/2',L0,IP0, & 'POINT',I1,X1,' ',L1,IPACC) IF (IERR.NE.0) RETURN IPND = (IDIM + 1) * (IPDEP - 1) IPNV = (IDIM + 1) * (IPVIT - 1) IPNA = (IDIM + 1) * (IPACC - 1) XPALB(I,ID1+1) = XCOOR(IPND + 1) XPALB(I,ID1+2) = XCOOR(IPNV + 1) XPALB(I,ID1+3) = XCOOR(IPNA + 1) GOTO 10 ** ianis * * ------ choc elementaire POINT_PLAN avec plasticite * ELSE IF (ITYP.EQ.100 .OR. ITYP.EQ.101 ) THEN C chargement du deplacement plastique CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE', & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2) IF (IERR.NE.0) RETURN IDIM = IPALB(I,3) id1 = 4 XPALB(I,(ID1+IDIM+1)) = XDPLAS GOTO 10 * * ------ choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE * ELSE IF (ITYP.EQ.16 .OR. ITYP.EQ.17) THEN C chargement du deplacement plastique et de la limite elastique CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE', & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2) IF (IERR.NE.0) RETURN * * le depl limite elastique ne sert plus a rien CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_LIMITE_ELASTIQUE', & L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2) IF (IERR.NE.0) RETURN CALL ACCTAB(ITREFI,'MOT',I0,X0,'DEPLACEMENT_PLASTIQUE_CUMULE', & L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2) IF (IERR.NE.0) RETURN idim = IPALB(I,3) if (ityp.eq.16) nn = 4 + idim if (ityp.eq.17) nn = 5 + idim XPALB(I,nn-2) = XDPLAS XPALB(I,nn-1) = XELA XPALB(I,nn) = XDPLAC GOTO 10 * * ------ choc elementaire POINT_POINT_ROTATION_PLASTIQUE * ELSE IF (ITYP.EQ.50 .OR. ITYP.EQ.51) THEN * chargement de la rotation plastique et de la limite elastique CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE', & L0,IP0,'FLOTTANT',I1,XDPLAS,' ',L1,IPOR2) IF (IERR.NE.0) RETURN * * la rot limite elastique ne sert plus a rien CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_LIMITE_ELASTIQUE', & L0,IP0,'FLOTTANT',I1,XELA,' ',L1,IPOR2) IF (IERR.NE.0) RETURN CALL ACCTAB(ITREFI,'MOT',I0,X0,'ROTATION_PLASTIQUE_CUMULE', & L0,IP0,'FLOTTANT',I1,XDPLAC,' ',L1,IPOR2) IF (IERR.NE.0) RETURN idim = IPALB(I,3) if (ityp.eq.50) nn = 4 + idim if (ityp.eq.51) nn = 5 + idim XPALB(I,nn-2) = XDPLAS XPALB(I,nn-1) = XELA XPALB(I,nn) = XDPLAC GOTO 10 C * -------choc elementaire LIGNE_LIGNE_FROTTEMENT * ELSE IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN * Chargement des noeudS leS plus proche CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0, & 'LISTENTI',I1,X1,' ',L1,IVOIS1) IF (IERR.NE.0) RETURN MLENTI = IVOIS1 SEGACT,MLENTI NNOE=LECT(/1) DO 30 JVOI=1,NNOE IPALB(I,26+JVOI)=LECT(JVOI) 30 CONTINUE SEGDES,MLENTI * -------chocS elementaireS SEGMENT_CERCLE_FROTTEMENT_sanreac ET ..._REACNOR * ELSE IF (ITYP.EQ.37 .OR. ITYP.EQ.38 & .OR. ITYP.EQ.39 .OR. ITYP.EQ.40) THEN * Chargement des noeudS leS plus proche CALL ACCTAB(ITREFI,'MOT',I0,X0,'NOEUDS_VOISINS',L0,IP0, & 'LISTENTI',I1,X1,' ',L1,IVOIS1) IF (IERR.NE.0) RETURN MLENTI = IVOIS1 SEGACT,MLENTI NNOE=LECT(/1) DO 32 JVOI=1,NNOE IPALB(I,26+JVOI)=LECT(JVOI) 32 CONTINUE SEGDES,MLENTI * * * * ------ choc .... * * ELSE IF (ITYP.EQ. ) THEN * ... * * ELSE GOTO 10 ENDIF * IF (ITYP.NE.35 .AND. ITYP.NE.36 .AND. ITYP.NE.37 & .AND. ITYP.NE.38 .AND. ITYP.NE.39 .AND. ITYP.NE.40) THEN * * Chargement de la position origine d'adherence * CALL ACCTAB(ITREFI,'MOT',I0,X0,'POSITION_ORIGINE_ADHERENCE', & L0,IP0,'POINT',I1,X1,' ',L1,IPOR0) IF (IERR.NE.0) RETURN IPN0 = (IDIM + 1) * (IPOR0 - 1) * * Chargement de la vitesse tangentielle * CALL ACCTAB(ITREFI,'MOT',I0,X0,'VITESSE_TANGENTIELLE',L0,IP0, & 'POINT',I1,X1,' ',L1,IPOR1) IF (IERR.NE.0) RETURN IPN1 = (IDIM + 1) * (IPOR1 - 1) * * Chargement de la force tangentielle * CALL ACCTAB(ITREFI,'MOT',I0,X0,'FORCE_DE_CHOC_TANGENTIELLE', & L0,IP0,'POINT',I1,X1,' ',L1,IPOR2) IF (IERR.NE.0) RETURN IPN2 = (IDIM + 1) * (IPOR2 - 1) DO 20 ID = 1,IDIM XPALB(I,ID0+ID) = XCOOR(IPN0 + ID) XPALB(I,ID1+ID) = XCOOR(IPN1 + ID) XPALB(I,ID2+ID) = XCOOR(IPN2 + ID) 20 CONTINUE * end do ENDIF * * Chargement de l'etat tangentiel de la liaison * CALL ACCTAB(ITREFI,'MOT',I0,X0,'ETAT_DU_FROTTEMENT',L0,IP0, & 'ENTIER',IGP,X1,' ',L1,IRP) IF (IERR.NE.0) RETURN IPALB(I,2) = IGP * 10 CONTINUE * end do * END