C DYNE72 SOURCE CHAT 11/03/16 21:19:41 6902 SUBROUTINE DYNE72(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR, & NIPALB,NIP,ITCARA) 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 Modele d�crivant les liaisons B * * e ITCARA Caract�ristiques * * 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 -INC SMMODEL -INC SMCHAML * SEGMENT,NCPR(XCOOR(/1)/(IDIM+1)) * LOGICAL L0,L1 CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE CHARACTER*8 CMOT * SEGINI,NCPR KCPR = NCPR MMODEL = ITLB segact mmodel MCHELM = ITCARA segact mchelm n1cara = imache(/1) * * 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 if (IL.GT.kmodel(/1)) then segdes mmodel,mchelm RETURN endif imodel = kmodel(il) segact imodel cmot(1:8) = cmatee meleme = imamod segact meleme NLIAB = NLIAB + 1 ica = 0 1010 ica = ica + 1 if (ica.gt.n1cara) then write(6,*) ' pas de caracteristiques pour ', il , cmatee goto 10 endif if (conche(ica).ne.conmod) goto 1010 if (imache(ica).ne.imamod) goto 1010 mchaml = ichaml(ica) segact mchaml n2cham = ielval(/1) 11 continue * * ------ choc �l�mentaire POINT_PLAN_FLUIDE * IF (CMOT.EQ.'PO_PL_FL') THEN INOE = num(1,1) 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.EQ.'PO_PL_FR') THEN do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LOIC') goto 1021 enddo KNIP = 0 goto 1022 1021 melval = ielval(in2) segact melval MEVOLL = ielche(1,1) 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 segdes melval * 1022 continue INOE = num(1,1) 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.EQ.'PO_PL') THEN do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LOIC') goto 1031 enddo KNIP = 0 goto 1032 1031 melval = ielval(in2) segact melval MEVOLL = ielche(1,1) 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 * 1032 continue INOE = num(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' KPLBB = 1 KDIMB = IDIM KIPALB = 4 KXPALB = 3 + IDIM ** ianis do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'SPLA') KXPALB = 3 + IDIM + 2 enddo * 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.EQ.'PO_PO_FR') THEN INOA = num(1,1) IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF INOB = num(1,2) IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LOIC') goto 1041 enddo KNIP = 0 goto 1042 1041 melval = ielval(in2) segact melval * ipevo = ielche(1,1) 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 segdes melval 1042 continue 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.EQ.'PO_PO_DP') THEN do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LOIC') goto 1051 enddo call erreur(5) return 1051 melval = ielval(in2) segact melval * ipevo = ielche(1,1) segdes melval 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 * INOA = num(1,1) IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF INOB = num(1,2) IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1052 endif enddo 1052 continue * 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.EQ.'PO_PO_RP') THEN do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LOIC') goto 1061 enddo call erreur(5) return 1061 melval = ielval(in2) segact melval ipevo = ielche(1,1) segdes melval * 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 * INOA = num(1,1) IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF INOB = num(1,2) IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1062 endif enddo 1062 continue 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.EQ.'PO_PO') THEN INOA = num(1,1) IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF INOB = num(1,2) IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LOIC') goto 1071 enddo KNIP = 0 goto 1072 1071 melval = ielval(in2) segact melval ipevo = ielche(1,1) segdes melval * 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 1072 continue 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.EQ.'PO_CE_MO') THEN INOA = num(1,1) IF (NCPR(INOA).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOA) = NPLB ENDIF * do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'PCER') goto 1081 enddo interr(1) = inoa moterr(1:4) = 'PCER' moterr(5:8) = 'CARA' call erreur(65) 1081 melval = ielval(in2) segact melval inob = ielche(1,1) IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1082 endif enddo 1082 continue 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.EQ.'PO_CE_FR') THEN INOE=num(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1092 endif enddo 1092 continue 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.EQ.'PO_CE') THEN INOE = num(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1102 endif enddo 1102 continue 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.EQ.'CE_PL_FR') THEN INOE = num(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1112 endif enddo 1112 continue 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.EQ.'CE_CE_FR') THEN INOE = num(1,1) IF (NCPR(INOE).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOE) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'AMOR') then typret='FLOTTANT' goto 1122 endif enddo 1122 continue 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.EQ.'PR_PR_IN'.OR. & CMOT.EQ.'PR_PR_EX') THEN do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'PFIX') then melval = ielval(in2) segact melval ima1 = ielche(1,1) segdes melval endif if (nomche(in2)(1:4).eq.'PMOB') then melval = ielval(in2) segact melval ima2 = ielche(1,1) segdes melval endif enddo INOE = num(1,1) 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.EQ.'LI_LI_FR') THEN MONESC= ' ' TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LIMA') then melval = ielval(in2) segact melval imai = ielche(1,1) segdes melval endif if (nomche(in2)(1:4).eq.'LIES') then melval = ielval(in2) MONESC = typche(in2)(9:16) segact melval iesc = ielche(1,1) segdes melval endif if (nomche(in2)(1:4).eq.'AMOR') then melval = ielval(in2) typret=typche(in2)(1:8) if (typret.eq.'POINTEUR') typret=typche(in2)(9:16) endif enddo * 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.'REAL*8') THEN KXPALB = 6 + (2*(NNOEMA+NNOEES)+4)*IDIM+(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.EQ.'LI_CE_FR') THEN MONESC= ' ' TYPRET = ' ' do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'LIMA') then melval = ielval(in2) segact melval imai = ielche(1,1) segdes melval endif if (nomche(in2)(1:4).eq.'LIES') then melval = ielval(in2) MONESC = typche(in2)(9:16) segact melval iesc = ielche(1,1) segdes melval endif if (nomche(in2)(1:4).eq.'AMOR') then melval = ielval(in2) typret=typche(in2)(1:8) if (typret.eq.'POINTEUR') typret=typche(in2)(9:16) endif enddo * 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.'REAL*8') 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.EQ.'PA_FL_RO') THEN * KPLBB = 1 KDIMB = IDIM * C I) Gestion du point support * INOE = num(1,1) 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 * c CALL ACCTAB(ITLIAI,'MOT',I0,X0,'MODELE_PALIER',L0,IP0, c & '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) : * * C -- Cas du palier cylindrique ou � lobes, avec mod�le de Rhode et Li : * itgeom = 0 NLOB = 0 do in2 = 1,n2cham if (nomche(in2)(1:4).eq.'TLOB') then melval = ielval(in2) segact melval itgeom = ielche(1,1) segdes melval endif enddo if (itgeom.gt.0) then 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) 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 segdes mchaml,imodel,meleme GOTO 10 * END