C CYNE72 SOURCE OF166741 25/02/20 21:16:00 12165 SUBROUTINE CYNE72(ITLB,IWRK52,ITRULI) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * voir dyne72.eso * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * 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 et DYNE72 * * * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMELEME -INC SMEVOLL -INC SMLREEL -INC SMMODEL -INC SMCHAML -INC DECHE ** segment sous-structures dynamiques segment struli integer itlia,itbmod,momoda, mostat,itmail,molia integer ldefo(np1),lcgra(np1),lsstru(np1) integer nsstru,nndefo,nliab,nsb,na2,idimb integer ktliab,ktphi,ktq,ktres,kpref,ktkam,kcpr,ktpas INTEGER NIPALB,NXPALB,NPLBB,NPLB,NIP,jliaib * ichain segment MLENTI initialise dans dyne12 (tjs actif si > 0) INTEGER ICHAIN endsegment * SEGMENT,NCPR(nbpts) * LOGICAL L0,L1 CHARACTER*8 TYPRET,MONSYM,MONESC,CMOT1,CHARRE CHARACTER*8 CMOT * IMODEL = ITLB wrk52 = iwrk52 struli = itruli SEGINI,NCPR KCPR = NCPR * index des liaisons B. Utilise le fait qu il n y a qu un seul point local jliaib = jliaib + 1 * NXPALB = 0 c c.a.d. 15 liaisons conditionelles (ca marche pas pour 'PROFIL..;') NIPALB = 20 NPLBB = 0 NPLB = 0 IDIMB = 0 cc 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 segact imodel cmot(1:8) = cmatee meleme = imamod segact meleme cc NLIAB = NLIAB + 1 ica = 0 n2cham = valmat(/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 if (valmat(/1).gt.7) then if (valmat(9).gt.0) goto 1021 endif KNIP = 0 goto 1022 1021 MEVOLL = int(valmat(9)) 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 if (valmat(/1).gt.3) then if (valmat(4).gt.0) goto 1031 endif KNIP = 0 goto 1032 1031 IPEVO = int(valmat(4)) 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 if (valmat(/1).gt.3) then if (valmat(6).gt.0) 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 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 if (valmat(/1).gt.11) then if (valmat(10).gt.0) goto 1041 endif KNIP = 0 goto 1042 1041 ipevo = int(valmat(10)) 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 if (valmat(6).gt.0) goto 1051 call erreur(5) return 1051 ipevo = int(valmat(7)) 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 = ' ' if (valmat(/1).gt.6) then if (valmat(7).gt.0) then typret='FLOTTANT' goto 1052 endif endif 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 if (valmat(6).gt.0) goto 1061 call erreur(5) return 1061 ipevo = int(valmat(6)) * 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 = ' ' if (valmat(/1).gt.6) then if (valmat(7).gt.0) then typret='FLOTTANT' goto 1062 endif endif 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 = ' ' if (valmat(/1).gt.5) then if (valmat(7).gt.0) goto 1071 endif KNIP = 0 goto 1072 1071 ipevo = int(valmat(7)) 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 * if (valmat(3).gt.0) goto 1081 interr(1) = inoa moterr(1:4) = 'PCER' moterr(5:8) = 'CARA' call erreur(65) 1081 inob = int(valmat(3)) IF (NCPR(INOB).EQ.0) THEN NPLB = NPLB + 1 NCPR(INOB) = NPLB ENDIF TYPRET = ' ' if (valmat(/1).gt.8) then if (valmat(10).gt.0) then typret='FLOTTANT' goto 1082 endif endif 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 if (valmat(/1).gt.8) then c if (valmat(10).gt.0) then c typret='FLOTTANT' c goto 1092 c endif c endif c 1092 continue cbp,2020 : ci-dessus inutile car on met toujours l'amortissement KPLBB = 1 KDIMB = IDIM KIPALB = 4 cbp,2020 IF (TYPRET.EQ.'FLOTTANT') THEN cbp,2020 KXPALB = 7 + 9 * IDIM cbp,2020 : ajout 2 reels pour la regularisation + 1*idim pour Ventrainement KXPALB = 10 + 9*IDIM cbp,2020 ELSE IF (TYPRET.EQ.' ') THEN cbp,2020 KXPALB = 6 + 9 * IDIM cbp,2020 ELSE cbp,2020 CALL ERREUR(522) cbp,2020 RETURN cbp,2020 ENDIF 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 = ' ' if (valmat(/1).gt.4) then if (valmat(5).gt.0) then typret='FLOTTANT' goto 1102 endif endif 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 = ' ' if (valmat(/1).gt.8) then if (valmat(9).gt.0) then typret='FLOTTANT' goto 1112 endif endif 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 = ' ' if (valmat(/1).gt.9) then if (valmat(10).gt.0) then typret='FLOTTANT' goto 1122 endif endif 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 ima1 = int(valmat(3)) ima2 = int(valmat(4)) 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) MELEME = IMA2 SEGACT MELEME NOMBN2 = NUM(/2) 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 = ' ' imai = int(valmat(2)) MONESC = tyval(3)(9:16) iesc = int(valmat(3)) MELEME = IESC SEGACT MELEME if (num(/2).eq.1) then MONESC = 'POINT' IESC = num(1,1) endif if (valmat(/1).ge.10) then typret=tyval(10)(1:8) if (typret.eq.'POINTEUR') typret=tyval(10)(9:16) endif * 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 * 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 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 = ' ' imai = int(valmat(2)) MONESC = tyval(3)(9:16) iesc = int(valmat(3)) MELEME = IESC SEGACT MELEME if (num(/2).eq.1) then MONESC = 'POINT' IESC = num(1,1) endif if (valmat(/1).gt.8) then if (valmat(9).gt.0) then typret=tyval(9)(1:8) if (typret.eq.'POINTEUR') typret=tyval(9)(9:16) endif endif * 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 * 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 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 * 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 e lobes, avec modele de Rhode et Li : * NLOB = 0 itgeom = int(valmat(10)) 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 END