C DYNE22 SOURCE CHAT 05/01/12 23:15:29 5004 SUBROUTINE DYNE22(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR, & NIPALB,NIP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Opérateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Détermination des paramètres de liaison pour la base B. * * * * Paramètres: * * * * e ITLB Table rassemblant la description des liaisons * * s NLIAB Nombre total de liaisons sur base B. * * s NXPALB Maxi du nombre de paramètres définissant une liaison. * * s NPLBB Maxi du nombre de points intervenant dans une liaison. * * s NPLB Nombre total de points. * * s IDIMB Dimension de travail des liaisons. * * s KCPR Segment de points. * * s NIPALB Maxi du nombre de paramètres définissant une liaison. * * s NIP Nb de pts dans l'evolution de la loi de comportement * * * * Auteur, date de création: * * * * Lionel VIVAN, le 21 Septembre 1989. * * derniere modification: * * Ibrahim PINTO , 05/1997 * *--------------------------------------------------------------------* -INC CCOPTIO -INC SMCOORD -INC SMELEME -INC SMEVOLL -INC SMLREEL * SEGMENT,NCPR(XCOOR(/1)/(IDIM+1)) * LOGICAL L0,L1 CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE CHARACTER*40 CMOT * SEGINI,NCPR KCPR = NCPR * * Boucle sur le nombre de liaisons * NXPALB = 0 c c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;') NIPALB = 20 NPLBB = 0 NPLB = 0 IDIMB = 0 NLIAB = 0 C NIP = 1 dans le cas ou la liaison n'est pas ITYP = 16/17 ou ITYP = 50/51 NIP = 1 IL = 0 10 CONTINUE IL = IL+ 1 TYPRET = ' ' CALL ACCTAB(ITLB,'ENTIER',IL,X0,' ',L0,IP0, & TYPRET,I0,X0,CHARRE,L1,ITLIAI) IF (IERR.NE.0) RETURN IF (ITLIAI.NE.0) THEN NLIAB = NLIAB + 1 CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0, & 'MOT',I1,X0,CMOT,L1,IP1) IF (IERR.NE.0) RETURN * * ------ choc élémentaire POINT_PLAN_FLUIDE * IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF KPLBB = 1 KDIMB = IDIM KIPALB = 3 KXPALB = 9 + IDIM NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ------ choc élémentaire POINT_PLAN_FROTTEMENT * ELSE IF (CMOT(1:21).EQ.'POINT_PLAN_FROTTEMENT') THEN TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, & IP0,TYPRET,I1,X1,' ',L1,IPEVO) IF (IERR.NE.0) RETURN * IF (TYPRET.EQ.'EVOLUTIO')THEN MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ELSE KNIP = 0 ENDIF * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' KPLBB = 1 KDIMB = IDIM KIPALB = 3 KXPALB = 7 + 7 * IDIM NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ------ choc élémentaire POINT_PLAN * ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, & IP0,TYPRET,I1,X1,' ',L1,IPEVO) IF (IERR.NE.0) RETURN * IF (TYPRET.EQ.'EVOLUTIO')THEN MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ELSE KNIP = 0 ENDIF * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' KPLBB = 1 KDIMB = IDIM KIPALB = 4 KXPALB = 3 + IDIM ** ianis TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SEUIL_PLASTIQUE', & L0,IP0,TYPRET,I1,XSEUIL,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ')THEN KXPALB = 3 + IDIM + 2 ENDIF * NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ----- choc élémentaire POINT_POINT_FROTTEMENT * ELSE IF (CMOT(1:22).EQ.'POINT_POINT_FROTTEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, & 'POINT',I1,X0,' ',L1,INOA) IF (IERR.NE.0) RETURN IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, & 'POINT',I1,X0,' ',L1,INOB) IF (IERR.NE.0) RETURN IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, & IP0,TYPRET,I1,X1,' ',L1,IPEVO) IF (IERR.NE.0) RETURN * IF (TYPRET.EQ.'EVOLUTIO')THEN MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ELSE KNIP = 0 ENDIF KPLBB = 2 KDIMB = IDIM KIPALB = 3 KXPALB = 7 + 7 * IDIM NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ----- choc elementaire POINT_POINT_DEPLACEMENT_PLASTIQUE * ELSE IF & (CMOT(1:33).EQ.'POINT_POINT_DEPLACEMENT_PLASTIQUE') THEN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, & IP0,'EVOLUTIO',I1,X1,' ',L1,IPEVO) IF (IERR.NE.0) RETURN * MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, & 'POINT',I1,X0,' ',L1,INOA) IF (IERR.NE.0) RETURN IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, & 'POINT',I1,X0,' ',L1,INOB) IF (IERR.NE.0) RETURN IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT', & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 2 KDIMB = IDIM C KIPALB = 5 IF (TYPRET.EQ.'FLOTTANT') THEN KXPALB = 5 + IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 4 + IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ----- choc elementaire POINT_POINT_ROTATION_PLASTIQUE * ELSE IF & (CMOT(1:30).EQ.'POINT_POINT_ROTATION_PLASTIQUE') THEN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, & IP0,'EVOLUTIO',I1,X1,' ',L1,IPEVO) IF (IERR.NE.0) RETURN * MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, & 'POINT',I1,X0,' ',L1,INOA) IF (IERR.NE.0) RETURN IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, & 'POINT',I1,X0,' ',L1,INOB) IF (IERR.NE.0) RETURN IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT', & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 2 * * NW Dans le cas de la rotule, on passe en dimension 6 * car on aura Ux,Uy,Uz,Rx,Ry,Rz * KDIMB = 3+IDIM * * KIPALB = 5 : nombre maxi de parametres pour la liaison * KIPALB = 5 IF (TYPRET.EQ.'FLOTTANT') THEN KXPALB = 5 + IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 4 + IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ----- choc élémentaire POINT_POINT * ELSE IF (CMOT(1:11).EQ.'POINT_POINT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_A',L0,IP0, & 'POINT',I1,X0,' ',L1,INOA) IF (IERR.NE.0) RETURN IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_B',L0,IP0, & 'POINT',I1,X0,' ',L1,INOB) IF (IERR.NE.0) RETURN IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I1,X0,'LOI_DE_COMPORTEMENT',L0, & IP0,TYPRET,I1,X1,' ',L1,IPEVO) IF (IERR.NE.0) RETURN * IF (TYPRET.EQ.'EVOLUTIO')THEN MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX MLREE2 = IPROGY SEGACT MLREE1 SEGACT MLREE2 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL ELSE KNIP = 0 ENDIF KPLBB = 2 KDIMB = IDIM KIPALB = 4 KXPALB = 3 + IDIM NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ianis * * ----- choc élémentaire POINT_CERCLE_MOBILE * ELSE IF (CMOT(1:19).EQ.'POINT_CERCLE_MOBILE') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOA) IF (IERR.NE.0) RETURN IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF CALL ACCTAB(ITLIAI,'MOT',I0,X0,'CERCLE',L0,IP0, & 'POINT',I1,X0,' ',L1,INOB) IF (IERR.NE.0) RETURN IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 2 * on neglige les rotations KDIMB = IDIM KIPALB = 4 IF (TYPRET.EQ.'FLOTTANT'.OR.TYPRET.EQ.'ENTIER ') THEN KXPALB = 7 + 9 * IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 6 + 9 * IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * * ----- choc élémentaire POINT_CERCLE_FROTTEMENT * ELSE IF (CMOT(1:23).EQ.'POINT_CERCLE_FROTTEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 1 KDIMB = IDIM KIPALB = 4 IF (TYPRET.EQ.'FLOTTANT') THEN KXPALB = 7 + 9 * IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 6 + 9 * IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc élémentaire POINT_CERCLE * ELSE IF (CMOT(1:12).EQ.'POINT_CERCLE') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT', & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 1 KDIMB = IDIM KIPALB = 3 IF (TYPRET.EQ.'FLOTTANT') THEN KXPALB = 3 + 2 * IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 2 + 2 * IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc élémentaire CERCLE_PLAN_FROTTEMENT * ELSE IF (CMOT(1:22).EQ.'CERCLE_PLAN_FROTTEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 1 KDIMB = 2 * IDIM KIPALB = 3 IF (TYPRET.EQ.'FLOTTANT') THEN KXPALB = 8 + 7 * IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 7 + 7 * IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc élémentaire CERCLE_CERCLE_FROTTEMENT * ELSE IF (CMOT(1:24).EQ.'CERCLE_CERCLE_FROTTEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0, & IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN KPLBB = 1 KDIMB = 2 * IDIM KIPALB = 4 IF (TYPRET.EQ.'FLOTTANT') THEN KXPALB = 8 + 9*IDIM ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 7 + 9*IDIM ELSE CALL ERREUR(522) RETURN ENDIF NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc élémentaire PROFIL_PROFIL_INTERIEUR * ----- choc élémentaire PROFIL_PROFIL_EXTERIEUR * ELSE IF (CMOT(1:23).EQ.'PROFIL_PROFIL_INTERIEUR' .OR. & CMOT(1:23).EQ.'PROFIL_PROFIL_EXTERIEUR') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0, & 'MAILLAGE',I1,X0,' ',L1,IMA1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0, & 'MAILLAGE',I1,X0,' ',L1,IMA2) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF KPLBB = 1 KDIMB = 3 CALL CHANGE(IMA1,1) CALL CHANGE(IMA2,1) MELEME = IMA1 SEGACT MELEME NOMBN1 = NUM(/2) SEGDES MELEME MELEME = IMA2 SEGACT MELEME NOMBN2 = NUM(/2) SEGDES MELEME KXPALB = 3 + 5*IDIM + 5*NOMBN1 + 3*NOMBN2 KIPALB = 5 + NOMBN1 + 2*NOMBN1*NOMBN2 NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc élémentaire LIGNE_LIGNE_FROTTEMENT * ELSE IF & (CMOT(1:22).EQ.'LIGNE_LIGNE_FROTTEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0, & 'MAILLAGE',I1,X1,' ',L1,IMAI) IF (IERR.NE.0) RETURN MONESC= ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0, & MONESC,I1,X1,CHARRE,L1,IESC) TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS', & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN * MELEME = IMAI SEGACT MELEME NELEMA = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN NNOEMA = NELEMA ELSE NNOEMA = NELEMA+1 ENDIF INOE = NUM(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF DO 20 IE = 1,(NNOEMA-1) INOE = NUM(2,IE) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF 20 CONTINUE SEGDES MELEME * Maillage_esclave IF (MONESC.EQ.'POINT') THEN * La ligne-esclave est un point IF (NCPR(IESC).EQ.0) THEN NPLB = NPLB + 1 NCPR(IESC) = NPLB ENDIF NNOEES=1 ELSE IF (MONESC.EQ.'MAILLAGE') THEN * La ligne-esclave est un MAILLAGE MELEME = IESC SEGACT MELEME NELEES = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN NNOEES = NELEES ELSE NNOEES = NELEES+1 ENDIF INOE = NUM(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF DO 30 IE = 1,(NNOEES-1) INOE = NUM(2,IE) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF 30 CONTINUE SEGDES MELEME ENDIF ENDIF KPLBB = NNOEMA + NNOEES IF (IDIM.EQ.3) THEN KDIMB = 6 ELSE KDIMB = 3 ENDIF * Pour le nombre maxi de paramètres entiers on prend * en compte les 16 espaces dus aux liaisons conditionnelles * + nos 10 autres propres paramètres * + la place pour les noeuds voisins * + la place pour les indicateurs de choc KIPALB = 16 + 10 +3*(NNOEMA+NNOEES) * IF (TYPRET.EQ.'CHPOINT') THEN KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+ &NNOEES) ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ &NNOEES) ELSE CALL ERREUR(522) RETURN ENDIF * NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc élémentaire LIGNE_CERCLE_FROTTEMENT ELSE IF & (CMOT(1:23).EQ.'LIGNE_CERCLE_FROTTEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_MAITRE',L0,IP0, & 'MAILLAGE',I1,X1,' ',L1,IMAI) IF (IERR.NE.0) RETURN MONESC= ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'LIGNE_ESCLAVE',L0,IP0, & MONESC,I1,X1,CHARRE,L1,IESC) TYPRET = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENTS', & L0,IP0,TYPRET,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN * MELEME = IMAI SEGACT MELEME NELEMA = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEMA)) THEN NNOEMA = NELEMA ELSE NNOEMA = NELEMA+1 ENDIF INOE = NUM(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF DO 40 IE = 1,(NNOEMA-1) INOE = NUM(2,IE) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF 40 CONTINUE SEGDES MELEME * Maillage_esclave IF (MONESC.EQ.'POINT') THEN * La ligne-esclave est un point IF (NCPR(IESC).EQ.0) THEN NPLB = NPLB + 1 NCPR(IESC) = NPLB ENDIF NNOEES=1 ELSE IF (MONESC.EQ.'MAILLAGE') THEN * La ligne-esclave est un MAILLAGE MELEME = IESC SEGACT MELEME NELEES = NUM(/2) IF (NUM(1,1).EQ.NUM(2,NELEES)) THEN NNOEES = NELEES ELSE NNOEES = NELEES+1 ENDIF INOE = NUM(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF DO 50 IE = 1,(NNOEES-1) INOE = NUM(2,IE) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF 50 CONTINUE SEGDES MELEME ENDIF ENDIF KPLBB = NNOEMA + NNOEES IF (IDIM.EQ.3) THEN KDIMB = 6 ELSE KDIMB = 3 ENDIF * Pour le nombre maxi de paramètres entiers on prend * en compte les 16 espaces dus aux liaisons conditionnelles * + nos 10 autres propres paramètres * + la place pour les noeuds voisins * + la place pour les indicateurs de choc KIPALB = 16 + 10 +3*(NNOEMA+NNOEES) * IF (TYPRET.EQ.'CHPOINT') THEN KXPALB = 7 + (2*(NNOEMA+NNOEES)+4)*IDIM+2*(NNOEMA+ &NNOEES) ELSE IF (TYPRET.EQ.' ') THEN KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(NNOEMA+ &NNOEES) ELSE CALL ERREUR(522) RETURN ENDIF * NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ------ liaison PALIER_FLUIDE * ELSE IF (CMOT(1:13).EQ.'PALIER_FLUIDE') THEN * KPLBB = 1 KDIMB = IDIM * C I) Gestion du point support * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0, & 'POINT',I1,X0,' ',L1,INOE) IF (IERR.NE.0) RETURN IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF * C II) Décompte du nombre de paramètres entiers et réels * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0, & 'MOT',I1,X0,CMOT,L1,IP1) IF (IERR.NE.0) RETURN * C II.1) Décompte du nombre de paramètres propres aux différents types C de paliers (KIPLB2 pour les entiers, LXPLB2 pour les réels) : * IF (CMOT.EQ.'RODELI') THEN * C -- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li : * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'GEOMETRIE_PALIER', & L0,IP0,'TABLE',I0,X0,' ',L1,ITGEOM) IF (IERR.NE.0) RETURN CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0, & 'ENTIER',NLOB,X0,' ',L1,IP1) IF (IERR.NE.0) RETURN KIPLB2 = 2 + NLOB KXPLB2 = 1 + (6*NLOB) * C -- Cas des autres types de paliers (à définir si nécessaire) * C ELSE IF (CMOT.EQ.'...') THEN C KIPLB2 = ... C KXPLB2 = ... ENDIF * C II.2) Nombres totaux de paramètres entiers et réels : * KIPALB = 5 + KIPLB2 KXPALB = 7 + KXPLB2 + 4 * C Dimensionnement des variables de sortie : * NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * --> fin liaison PALIER * ELSE CALL ERREUR(490) RETURN ENDIF GOTO 10 ENDIF * END