C DYNE20 SOURCE BP208322 19/02/25 21:15:59 10120 SUBROUTINE DYNE20(ILIB,KTLIAB) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Remplissage des tableaux de description des liaisons sur * * la base a partir des informations contenues dans la * * table ILIB. * * * * Parametres: * * * * e ILIB Table rassemblant la description des liaisons * * es KTLIAB Segment descriptif des liaisons sur la base B. * * * * * * Parametres de dimensionnement pour une liaison sur base: * * * * NIPALB : nombre de parametres pour definir le type des * * liaisons (NIPALB est fixe a 3). * * NXPALB : nombre maxi de parametres internes definissant les * * liaisons. * * NPLBB : nombre maxi de points intervenant dans une liaison. * * * * NPLB : nombre total de points. * * NLIAB : nombre total de liaisons. * * * * * * Tableaux fortran pour les liaisons sur base B : * * * * XPALB(NLIAB,NXPALB) : parametres de la liaison. * * IPALB(NLIAB,NIPALB) : renseigne sur le type de liaison. * * et les eventuelles conditions * * XABSCI Tableau contenant les abscisses de la loi plastique * * pour les liaisons point-point- ... -plastique * * XORDON Tableau contenant les ordonnees de la loi plastique * * pour les liaisons point-point- ... -plastique * * * * JPLIB(NPLB) : numero global des points. * * IPLIB(NLIAB,NPLBB) : numeros locaux des points concernes par * * la liaison. * * * * Icorres Pour garder le numero du pointeur des tables de * * liaison * * * * * * Auteur, date de creation: * * * * Lionel VIVAN, le 21 Septembre 1989. * * E de LANGRE 08/94 laisns conditionnelles * * I. Pinto 05/97, liaisons ligne_cercle,appels a dyn207 * * * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO * 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 * SEGMENT icorres( nliab) * LOGICAL L1,L0 CHARACTER*40 CMOT,MONMOT,CHARRE MTLIAB = KTLIAB NPLB = JPLIB(/1) NLIAB = IPALB(/1) segini icorres * * Boucle sur le nombre de liaisons * II = 0 * DO 10 I = 1,NLIAB CALL ACCTAB(ILIB,'ENTIER',I,X0,' ',L0,IP0, & 'TABLE',I0,X0,' ',L1,ITLIAI) icorres ( i )=itliai IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0, & 'MOT',I1,X0,MONMOT,L1,IP1) IF (IERR.NE.0) RETURN * * Liaison elementaire * IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN CMOT=' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0, & 'MOT',I1,X0,CMOT,L1,IP1) IF (IERR.NE.0) RETURN * * attention a l'ordre : en dernier les + courts !!! IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN ITYP = 3 CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN ITYP = 5 CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSEIF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN ITYP = 7 CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSEIF (CMOT(1:10).EQ.'POINT_PLAN') THEN ITYP = 1 CALL DYN201(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF & (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN ITYP = 50 CALL DYN205(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN ITYP = 13 CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF & (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN ITYP = 16 CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN ITYP = 11 CALL DYN202(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN ITYP = 23 CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN ITYP = 25 CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN ITYP = 33 CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN ITYP = 21 CALL DYN203(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR') THEN ITYP = 31 CALL DYN204(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN ITYP = 32 CALL DYN204(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE IF (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN ITYP = 35 CALL DYN206(I,ITLIAI,ITYP,KTLIAB,NPLB) ELSE IF(CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN ITYP = 37 CALL DYN207(I,ITLIAI,ITYP,KTLIAB,NPLB) ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN ITYP = 60 CALL DYN208(I,ITLIAI,ITYP,KTLIAB,NPLB) IF (IERR.NE.0) RETURN ELSE CALL ERREUR(490) RETURN ENDIF * * Liaison ........... * * ELSE IF (MONMOT(1: ).EQ.' ') THEN * ....... * ....... * ELSE CALL ERREUR(489) RETURN ENDIF 10 CONTINUE * * * * * ----- liaisons conditionnelles ? * * DO 11 I = 1,NLIAB ksi = 0 CALL ACCTAB(ILIB,'ENTIER',I,X0,' ',L0,IP0, & 'TABLE',I0,X0,' ',L1,ITLIAI) * la I^eme liaison est-elle conditionnee par la J^eme DO 12 j = 1,NLIAB jtliai = icorres ( j ) monmot = ' ' CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai, & MONMOT,I1,X0,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN * ------- si on trouve un logique en face d'une table * de liaison , c'est bon IF (MONMOT.EQ.'LOGIQUE ') THEN ksi = ksi + 1 if(ipalb(i,4).ge.2) then CALL ERREUR(905) return endif ipalb(i,4) = 1 IF (L1 ) THEN ipalb (i,4+ksi) = j ELSE IF (.NOT. L1) THEN ipalb (i,4+ksi) = -1 * j ENDIF ENDIF 12 CONTINUE 11 CONTINUE * --------- fin des conditions ***** eventuel message **** IF (IIMPI.EQ.333) THEN NLIAB = IPALB(/1) NIPALB = IPALB(/2) NXPALB = XPALB(/2) NPLBB = IPLIB(/2) NPLB = JPLIB(/1) DO 1000 IN = 1,NLIAB DO 1002 II = 1,NIPALB WRITE(IOIMP,*)'DYNE20 : IPALB(',IN,',',II,') =',IPALB(IN,II) 1002 CONTINUE DO 1004 IX = 1,NXPALB WRITE(IOIMP,*)'DYNE20 : XPALB(',IN,',',IX,') =',XPALB(IN,IX) 1004 CONTINUE DO 1006 IP = 1,NPLBB WRITE(IOIMP,*)'DYNE20 : IPLIB(',IN,',',IP,') =',IPLIB(IN,IP) 1006 CONTINUE 1000 CONTINUE DO 1008 IP = 1,NPLB WRITE(IOIMP,*)'DYNE20 : JPLIB(',IP,') =',JPLIB(IP) 1008 CONTINUE ENDIF * RETURN END