C DYN208 SOURCE BP208322 19/02/25 21:15:58 10120 SUBROUTINE DYN208(I,ITLB,ITYP,KTLIAB,NPLB) 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 des informations contenues dans la table ILIB * * Liaison de type PALIER). * * * * Paramètres: * * * * e I Numéro de la liaison. * * e ITLB Table rassemblant la description d'une liaison. * * e ITYP Type de la liaison. * * s KTLIAB Segment descriptif des liaisons sur base B. * * e NPLB Nombre total de points. * * * * * * Auteur, date de création: Valérie BOISSON, le 14 mai 1997 * * Modif : BP, 2015 : ajout palier court/long et point_origine * * certains parametres deviennent optionnels * * * *--------------------------------------------------------------------* -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 PARAMETER (X2Pi= 6.283185307179586476925286766559D0) * LOGICAL L1,L0 CHARACTER*40 MODPAL CHARACTER*10 MOCAVI CHARACTER*8 TYPRET,CHARRE CALL ACCTAB(ITLB,'MOT',I0,X0,'MODELE_PALIER',L0,IP0, & 'MOT',I1,X1,MODPAL,L1,IP1) IF (IERR.NE.0) RETURN MTLIAB = KTLIAB * CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT_SUPPORT',L0,IP0, & 'POINT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN CALL PLACE2(JPLIB,NPLB,IPLAC,IP1) IPLIB(I,1) = IPLAC if (iimpi.eq.333) write(ioimp,*) 'liaison ',I, & ' p_support #',IP1,'->IPLAC=',IPLAC * * TYPRET=' ' CALL ACCTAB(ITLB,'MOT',I0,X0,'POINT_ORIGINE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP2) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'POINT') THEN CALL PLACE2(JPLIB,NPLB,IPLAC,IP2) IPLIB(I,2) = IPLAC if (iimpi.eq.333) write(ioimp,*) 'liaison ',I, & ' p_origine #',IP2,'->IPLAC=',IPLAC ELSE IPLIB(I,2) = 0 ENDIF * * Valeurs de IPALB et XPALB communes à tous les types de paliers fluides : * IPALB(I,1) = ITYP IPALB(I,2) = 0 IPALB(I,3) = 3 IPALB(I,4) = 0 * CALL ACCTAB(ITLB,'MOT',I0,X0,'VISCOSITE_FLUIDE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,1) = X1 CALL ACCTAB(ITLB,'MOT',I0,X0,'RHO_FLUIDE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,2) = X1 CALL ACCTAB(ITLB,'MOT',I0,X0,'PRESSION_ADMISSION',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,3) = X1 CALL ACCTAB(ITLB,'MOT',I0,X0,'LONGUEUR_PALIER',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,4) = X1 TYPRET=' ' CALL ACCTAB(ITLB,'MOT',I0,X0,'AFFICHAGE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'FLOTTANT') XPALB(I,5) = X1 CALL ACCTAB(ITLB,'MOT',I0,X0,'RAYON_ARBRE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,6) = X1 CALL ACCTAB(ITLB,'MOT',I0,X0,'VITESSE_ROTATION',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,7) = X1 TYPRET=' ' CALL ACCTAB(ITLB,'MOT' ,I0,X0,'EPSI',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'FLOTTANT') THEN XPALB(I,8) = X1 ELSE XPALB(I,8) = 0.D0 ENDIF TYPRET=' ' CALL ACCTAB(ITLB,'MOT',I0,X0,'PHII',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'FLOTTANT') XPALB(I,9) = X1 * *---- Cas du palier cylindrique ou à lobes, avec modèle de Rhode et Li IF (MODPAL.EQ.'RODELI') THEN * IPALB(I,5) = 1 CALL ACCTAB(ITLB,'MOT',I0,X0,'GEOMETRIE_PALIER',L0,IP0, & 'TABLE',I1,X1,CHARRE,L1,ITGEOM) IF (IERR.NE.0) RETURN CALL ACCTAB(ITGEOM,'MOT',I0,X0,'NOMBRE_LOBES',L0,IP0, & 'ENTIER',NLOB,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IPALB(I,6) = NLOB C Nombre de parametres reels : NBPR = 6 IPALB(I,7) = NBPR TYPRET=' ' CALL ACCTAB(ITGEOM,'MOT',I0,X0,'CRITERE_ARRET',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'FLOTTANT') THEN XPALB(I,10) = X1 ELSE XPALB(I,10) = 1.D-5 ENDIF c boucle sur les eventuels lobes DO 10 ILOB = 1, NLOB * CALL ACCTAB(ITGEOM,'ENTIER',ILOB,X0,' ',L0,IP0, & 'TABLE',I1,X1,CHARRE,L1,ITLOB) IF (IERR.NE.0) RETURN c remplissage des parametres reels dans XPALB CALL ACCTAB(ITLOB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,11+NBPR*(ILOB-1)) = X1 CALL ACCTAB(ITLOB,'MOT',I0,X0,'ASYMETRIE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,12+NBPR*(ILOB-1)) = X1 CALL ACCTAB(ITLOB,'MOT',I0,X0,'PRECHARGE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,13+NBPR*(ILOB-1)) = X1 CALL ACCTAB(ITLOB,'MOT',I0,X0,'ANGLE_DEBUT',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,14+NBPR*(ILOB-1)) = X1 ANGDEB = X1 CALL ACCTAB(ITLOB,'MOT',I0,X0,'AMPL_ANGLE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,15+NBPR*(ILOB-1)) = X1 AMPLIT=X1 TYPRET=' ' CALL ACCTAB(ITLOB,'MOT',I0,X0,'COEF_SUR',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'FLOTTANT') THEN XPALB(I,16+NBPR*(ILOB-1)) = X1 ELSE XPALB(I,16+NBPR*(ILOB-1)) = 1.715D0 ENDIF c creation de la liste {... cos(teta_i) sin(teta_i) ...} c pour eviter son recalcul a chaque pas de temps c et stockage du listreel dans IPALB (au lieu de NB_MAILLES) TYPRET=' ' CALL ACCTAB(ITLOB,'MOT',I0,X0,'NB_MAILLES',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'ENTIER') THEN NMAIL=I1 ELSE NMAIL=100 ENDIF CALL COS208(ANGDEB,AMPLIT,NMAIL,KLREEL) IPALB(I,7+ILOB)=KLREEL c on ecrit ce listreel dans la table afin qu'il ne soit pas c supprime si menage pendant l'execution c (concerne surtout pasapas et donc cyne20) CALL ECCTAB(ITLOB,'MOT',I0,X0,'COSSIN',L0,IP0, & 'LISTREEL',I1,X1,CHARRE,L1,KLREEL) 10 CONTINUE * *---- Cas du palier court ou long ELSEIF (MODPAL.EQ.'PALIER_COURT'.OR.MODPAL.EQ.'PALIER_LONG') THEN IF (MODPAL.EQ.'PALIER_COURT') THEN IPALB(I,5) = 2 ELSEIF(MODPAL.EQ.'PALIER_LONG') THEN IPALB(I,5) = 3 ENDIF CALL ACCTAB(ITLB,'MOT',I0,X0,'JEU_USINAGE',L0,IP0, & 'FLOTTANT',I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN XPALB(I,10) = X1 TYPRET=' ' MOCAVI=' ' CALL ACCTAB(ITLB,'MOT',I0,X0,'CAVITATION',L0,IP0, & TYPRET,I1,X1,MOCAVI,L1,IP1) IF (IERR.NE.0) RETURN IF(MOCAVI.EQ.'SOMMERFELD') THEN IPALB(I,6) = 1 ELSEIF(MOCAVI.EQ.'GUMBEL') THEN IPALB(I,6) = 2 ELSE * par defaut on prend Gumbel IPALB(I,6) = 2 ENDIF c creation de la liste {... cos(teta_i) sin(teta_i) ...} c pour eviter son recalcul a chaque pas de temps c et stockage du listreel dans IPALB (au lieu de NB_MAILLES) TYPRET=' ' CALL ACCTAB(ITLB,'MOT',I0,X0,'NB_MAILLES',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN IF(TYPRET.EQ.'ENTIER') THEN if(I1.lt.36) then write(ioimp,*) 'NB_MAILLES doit etre >36, on prend 36' I1=36 elseif(I1.gt.1800) then write(ioimp,*) 'NB_MAILLES doit etre <1800, on prend 1800' I1=1800 endif NMAIL=I1 ELSE IF(IIMPI.EQ.333) & write(ioimp,*) 'NB_MAILLES non précisé, on prend 120' NMAIL=120 ENDIF CALL COS208(0.D0,X2Pi,NMAIL,KLREEL) IPALB(I,7)=KLREEL *---- Autres cas, non définis à ce jour * C ELSE IF (MODPAL.EQ.'...') THEN * ENDIF * END