C DYNE72 SOURCE CB215821 20/11/04 21:16:20 10766 SUBROUTINE DYNE72(ITLB, NLIAB,NXPALB,NPLBB,NPLB,IDIMB,KCPR, & NIPALB,NIP,ITCARA) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : * * Determination des parametres de liaison pour la base B. * * * *--------------------------------------------------------------------* * * * Parametres: * * * * e ITLB Modele decrivant les liaisons B * * e ITCARA Caracteristiques * * s NLIAB Nombre total de liaisons sur base B. * * s NXPALB Maxi du nombre de parametres definissant 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 parametres definissant une liaison. * * s NIP Nb de pts dans l'evolution de la loi de comportement * * * * Auteur, date de creation: JK, a partir de DYNE22 * * * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMELEME -INC SMEVOLL -INC SMLREEL -INC SMMODEL -INC SMCHAML * SEGMENT,NCPR(nbpts) * LOGICAL L0,L1 CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE CHARACTER*8 CMOT CHARACTER*4 MO4 * SEGINI,NCPR KCPR = NCPR MMODEL = ITLB segact mmodel MCHELM = ITCARA segact mchelm n1cara = imache(/1) * 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 * *--------------------------------------------------------------------* * Boucle sur le nombre de liaisons *--------------------------------------------------------------------* 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 elementaire 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 elementaire POINT_PLAN_FROTTEMENT * ELSE IF (CMOT.EQ.'PO_PL_FR') THEN do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.eq.'LOIC') goto 1021 enddo KNIP = 0 goto 1022 1021 melval = ielval(in2) segact melval ipevo = ielche(1,1) segdes melval * MEVOLL = ipevo SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX SEGACT MLREE1 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 C* MLREE2 = IPROGY C* SEGACT MLREE2 C* SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL * 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 cbp,2020 KXPALB = 7 + 7 * IDIM KXPALB = 9 + 8 * IDIM NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) NIP = MAX(NIP,KNIP) * * ------ choc elementaire POINT_PLAN * ELSE IF (CMOT.EQ.'PO_PL') THEN do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.eq.'LOIC') goto 1031 enddo KNIP = 0 goto 1032 1031 melval = ielval(in2) segact melval IPEVO = ielche(1,1) segdes,melval MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX SEGACT MLREE1 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 C* MLREE2 = IPROGY C* SEGACT MLREE2 C* 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 MO4=nomche(in2)(1:4) if (MO4.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 elementaire 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 MO4=nomche(in2)(1:4) if (MO4.eq.'LOIC') goto 1041 enddo KNIP = 0 goto 1042 1041 melval = ielval(in2) segact melval ipevo = ielche(1,1) segdes melval * MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX SEGACT MLREE1 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 C* MLREE2 = IPROGY C* SEGACT MLREE2 C* SEGDES MLREE2 SEGDES KEVOLL SEGDES MEVOLL 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 MO4=nomche(in2)(1:4) if (MO4.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 SEGACT MLREE1 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 c* MLREE2 = IPROGY c* SEGACT MLREE2 c* 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 MO4=nomche(in2)(1:4) if (MO4.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 MO4=nomche(in2)(1:4) if (MO4.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 SEGACT MLREE1 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 c* MLREE2 = IPROGY c* SEGACT MLREE2 c* 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 MO4=nomche(in2)(1:4) if (MO4.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 elementaire 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 MO4=nomche(in2)(1:4) if (MO4.eq.'LOIC') goto 1071 enddo KNIP = 0 goto 1072 1071 continue melval = ielval(in2) segact melval ipevo = ielche(1,1) segdes melval * MEVOLL = IPEVO SEGACT MEVOLL KEVOLL = IEVOLL(1) SEGACT KEVOLL MLREE1 = IPROGX SEGACT MLREE1 KNIP = MLREE1.PROG(/1) SEGDES MLREE1 c* MLREE2 = IPROGY c* SEGACT MLREE2 c* 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 elementaire 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 MO4=nomche(in2)(1:4) if (MO4.eq.'PCER') goto 1081 enddo interr(1) = inoa moterr(1:4) = 'PCER' moterr(5:8) = 'CARA' call erreur(65) return 1081 continue melval = ielval(in2) segact melval inob = ielche(1,1) segdes,melval IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.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 elementaire 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 c TYPRET = ' ' c do in2 = 1,n2cham c MO4=nomche(in2)(1:4) c if (MO4.eq.'AMOR') then c typret='FLOTTANT' c goto 1092 c endif c enddo c 1092 continue cbp,2020 : tjrs amortissement KPLBB = 1 KDIMB = IDIM KIPALB = 4 c IF (TYPRET.EQ.'FLOTTANT') THEN c KXPALB = 7 + 9 * IDIM c ELSE IF (TYPRET.EQ.' ') THEN c KXPALB = 6 + 9 * IDIM c ELSE c CALL ERREUR(522) c RETURN c ENDIF cbp,2020 : tjrs amortissement + ajout Ve et regul(n et t) KXPALB = 10 + 9 * IDIM NXPALB = MAX(NXPALB,KXPALB) NIPALB = MAX(NIPALB,KIPALB) NPLBB = MAX(NPLBB,KPLBB) IDIMB = MAX(IDIMB,KDIMB) * * ----- choc elementaire 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 MO4=nomche(in2)(1:4) if (MO4.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 elementaire 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 MO4=nomche(in2)(1:4) if (MO4.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 elementaire 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 MO4=nomche(in2)(1:4) if (MO4.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 elementaire PROFIL_PROFIL_INTERIEUR * ----- choc elementaire PROFIL_PROFIL_EXTERIEUR * ELSE IF (CMOT.EQ.'PR_PR_IN'.OR. & CMOT.EQ.'PR_PR_EX') THEN do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.eq.'PFIX') then melval = ielval(in2) segact melval ima1 = ielche(1,1) segdes melval elseif (MO4.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 elementaire LIGNE_LIGNE_FROTTEMENT * ELSE IF (CMOT.EQ.'LI_LI_FR') THEN MONESC= ' ' TYPRET = ' ' do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.eq.'LIMA') then melval = ielval(in2) segact melval imai = ielche(1,1) segdes melval elseif (MO4.eq.'LIES') then melval = ielval(in2) MONESC = typche(in2)(9:16) segact melval iesc = ielche(1,1) segdes melval elseif (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 parametres entiers on prend * en compte les 16 espaces dus aux liaisons conditionnelles * + nos 10 autres propres parametres * + 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 elementaire LIGNE_CERCLE_FROTTEMENT ELSE IF (CMOT.EQ.'LI_CE_FR') THEN MONESC= ' ' TYPRET = ' ' do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.eq.'LIMA') then melval = ielval(in2) segact melval imai = ielche(1,1) segdes melval elseif (MO4.eq.'LIES') then melval = ielval(in2) MONESC = typche(in2)(9:16) segact melval iesc = ielche(1,1) segdes melval elseif (MO4.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 parametres entiers on prend * en compte les 16 espaces dus aux liaisons conditionnelles * + nos 10 autres propres parametres * + 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 (uniquement RHODE_LI) * ELSE IF (CMOT.EQ.'PA_FL_RO') THEN * cbp KPLBB = 1 KPLBB = 2 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 cbp : si + tard on souhaite avoir une compatibilite entre la table DYNE c et la table PASAPAS, il faudra ecrire des choses ici... cf DYNE22 * C II) Decompte du nombre de parametres entiers et reels * 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) Decompte du nombre de parametres propres aux differents types C de paliers (KIPLB2 pour les entiers, LXPLB2 pour les reels) : * C -- Cas du palier cylindrique ou a lobes, avec modele de Rhode et Li : * itgeom = 0 NLOB = 0 do in2 = 1,n2cham MO4=nomche(in2)(1:4) if (MO4.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 parametres entiers et reels : * KIPALB = 5 + KIPLB2 cbp KXPALB = 7 + KXPLB2 + 4 KXPALB = 9 + KXPLB2 * 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 * RETURN END