C DYNE19 SOURCE CHAT 06/06/01 21:16:22 5450 SUBROUTINE DYNE19(ILIA,KCPR,PDT,KTLIAA) 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 a partir des informations contenues dans la * * table ILIA. * * * * Parametres: * * * * e ILIA Table rassemblant la description des liaisons * * e KCPR Segment descriptif des points. * * e PDT Pas de temps. * * es KTLIAA Segment descriptif des liaisons sur la base A. * * * * Parametres de dimensionnement pour une liaison sur base: * * * * NIPALA : nombre de parametres pour definir le type des * * liaisons (NIPALA est fixe a 3). * * NXPALA : nombre maxi de parametres internes pour definir * * les liaisons. * * NPLAA : nombre maxi de points intervenant dans une liaison. * * * * NPLA : nombre total de points. * * NLIAA : nombre total de liaisons. * * * * * * Tableaux fortran pour les liaisons sur base: * * * * XPALA(NLIAA,NXPALA) : param}tres de la liaison. * * IPALA(NLIAA,NIPALA) : renseigne sur le type de liaison. * * JPLIA(NPLA) : num{ro global des points. * * IPLIA(NLIAA,NPLAA) : num{ros locaux des points concern{s par * * la liaison. * * * * Auteur, date de cr{ation: * * * * Lionel VIVAN, le 21 aout 1989. * * * *--------------------------------------------------------------------* * -INC CCOPTIO -INC CCNOYAU -INC SMCOORD -INC SMTABLE -INC CCASSIS * SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) * SEGMENT MTLIAA INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) REAL*8 XPALA(NLIAA,NXPALA) ENDSEGMENT SEGMENT icorres (nliaa) * LOGICAL L0,L1 CHARACTER*8 MONAMO,MONOBJ,TYPIND,TYPOBJ,CHARRE CHARACTER*40 CMOT,MONMOT CHARACTER*(20) CHAI1 CHARACTER*(18) CHAI2 CHARACTER*(15) CHAI3 CHARACTER*(16) CHAI4 CHARACTER*(14) CHAI5 CHARACTER*(11) CHAI6 PARAMETER (XZERO = 0.D0) DATA CHAI1 /'EXPOSANT_DEPLACEMENT'/ DATA CHAI2 /'RETARD_DEPLACEMENT'/ DATA CHAI3 /'JEU_DEPLACEMENT'/ DATA CHAI4 /'EXPOSANT_VITESSE'/ DATA CHAI5 /'RETARD_VITESSE'/ DATA CHAI6 /'JEU_VITESSE'/ * ICPR = KCPR MTLIAA = KTLIAA NLIAA = IPALA(/1) NXPALA = XPALA(/2) NIPALA = IPALA(/2) NPLAA = IPLIA(/2) NPLA = JPLIA(/1) XPDTS2 = 0.5 * PDT segini icorres * * Boucle sur le nombre de liaisons * II = 0 DO 10 I = 1,NLIAA CALL ACCTAB(ILIA,'ENTIER',I,X0,' ',L0,IP0, & 'TABLE',I0,X0,' ',L1,ITLIAI) IF (IERR.NE.0) RETURN icorres ( i ) = itliai CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SOUSTYPE',L0,IP0, & 'MOT',I1,X0,MONMOT,L1,IP1) IF (IERR.NE.0) RETURN * * Liaison {l{mentaire * IF (MONMOT(1:19).EQ.'LIAISON_ELEMENTAIRE') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0, & 'MOT',I1,X0,CMOT,L1,IP1) IF (IERR.NE.0) RETURN * IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN * * ------------ choc POINT_PLAN_FLUIDE * CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X1,' ',L1,IMOD) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_INERTIE', & L0,IP0,'FLOTTANT',I0,XINER,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_CONVECTION', & L0,IP0,'FLOTTANT',I0,XCONV,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'COEFFICIENT_VISCOSITE', & L0,IP0,'FLOTTANT',I0,XVISC,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0, & 'COEFFICIENT_P_D_C_ELOIGNEMENT',L0,IP0, & 'FLOTTANT',I0,XPCEL,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0, & 'COEFFICIENT_P_D_C_RAPPROCHEMENT',L0,IP0, & 'FLOTTANT',I0,XPCRA,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU_FLUIDE',L0,IP0, & 'FLOTTANT',I0,XJEU,' ',L1,IP1) IF (IERR.NE.0) RETURN * IPALA(I,1) = 3 XPALA(I,1) = XINER XPALA(I,2) = XCONV XPALA(I,3) = XVISC XPALA(I,4) = XPCEL XPALA(I,5) = XPCRA XPALA(I,6) = XJEU IK = ICPR(IMOD) IPLIA(I,1) = IK JPLIA(IK) = IMOD ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN MONAMO = ' ' CALL ACCTAB(ITLIAI,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0, & MONAMO,I1,XAMO,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN * * ------------ choc POINT_PLAN avec amortissement * IF (MONAMO.EQ.'FLOTTANT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X1,' ',L1,IMOD) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0, & 'FLOTTANT',I0,XRAID,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0, & 'FLOTTANT',I0,XJEU,' ',L1,IP1) IF (IERR.NE.0) RETURN * IPALA(I,1) = 2 XPALA(I,1) = XRAID XPALA(I,2) = XJEU XPALA(I,3) = XAMO IK = ICPR(IMOD) IPLIA(I,1) = IK JPLIA(IK) = IMOD * * ------------ choc POINT_PLAN sans amortissement * ELSE CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X1,' ',L1,IMOD) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'RAIDEUR',L0,IP0, & 'FLOTTANT',I0,XRAID,' ',L1,IP1) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I1,X0,'JEU',L0,IP0, & 'FLOTTANT',I0,XJEU,' ',L1,IP1) IF (IERR.NE.0) RETURN * IPALA(I,1) = 1 XPALA(I,1) = XRAID XPALA(I,2) = XJEU IK = ICPR(IMOD) IPLIA(I,1) = IK JPLIA(IK) = IMOD ENDIF * * --------- liaison de couplage en vitesse * ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X1,' ',L1,ISUPP) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0, & 'POINT',I1,X1,' ',L1,IORIG) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0, & 'FLOTTANT',I1,XCPLGE,' ',L1,IP1) IF (IERR.NE.0) RETURN * IPALA(I,1) = 4 XPALA(I,1) = XCPLGE IKX = ICPR(ISUPP) IPLIA(I,1) = IKX JPLIA(IKX) = ISUPP IKY = ICPR(IORIG) IPLIA(I,2) = IKY JPLIA(IKY) = IORIG * * --------- liaison de couplage en d{placement * ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X1,' ',L1,ISUPP) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'ORIGINE',L0,IP0, & 'POINT',I1,X1,' ',L1,IORIG) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0, & 'FLOTTANT',I1,XCPLGE,' ',L1,IP1) IF (IERR.NE.0) RETURN * IPALA(I,1) = 5 XPALA(I,1) = XCPLGE IKX = ICPR(ISUPP) IPLIA(I,1) = IKX JPLIA(IKX) = ISUPP IKY = ICPR(IORIG) IPLIA(I,2) = IKY JPLIA(IKY) = IORIG * * --------- liaison de type force POLYNOMIALE * ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'SUPPORT',L0,IP0, & 'POINT',I1,X1,' ',L1,ISUPP) IF (IERR.NE.0) RETURN CALL ACCTAB(ITLIAI,'MOT',I0,X0,'COEFFICIENT',L0,IP0, & 'FLOTTANT',I1,XCOEF,' ',L1,IP1) IF (IERR.NE.0) RETURN * on met un flag reconnaissable ( cf dypol1) pour * reconnaissance du temps de demmarrage de la liaison do 101 ip = 1 , nxpala xpala(i,ip) = 123456.7 101 continue IPALA(I,1) = 6 IKX = ICPR(ISUPP) IPLIA(I,1) = IKX JPLIA(IKX) = ISUPP XPALA(I,1) = XCOEF MTABLE = ITLIAI SEGACT MTABLE NIND1 = MLOTAB * * contributions des autres modes * K1 = 2 K2 = 1 if(nbesc.ne.0) segact ipiloc DO 20 J=1,NIND1 * -- valeurs nulles par défaut XPALA(I,K1) = 0d0 XPALA(I,K1+1) = 0d0 XPALA(I,K1+2) = 0d0 XPALA(I,K1+3) = 0d0 XPALA(I,K1+4) = 0d0 XPALA(I,K1+5) = 0d0 TYPIND = MTABTI(J) IF (TYPIND.EQ.'POINT ') THEN TYPOBJ = MTABTV(J) IF (TYPOBJ.EQ.'TABLE ') THEN K2 = K2 + 1 IORIG = MTABII(J) IKX = ICPR(IORIG) IPLIA(I,K2) = IKX JPLIA(IKX) = IORIG MTAB1 = MTABIV(J) SEGACT MTAB1 NIND2 = MTAB1.MLOTAB RD = XZERO RV = XZERO DO 30 K=1,NIND2 TYPIND = MTAB1.MTABTI(K) IF (TYPIND.EQ.'MOT ') THEN IP = MTAB1.MTABII(K) ID = IPCHAR(IP) IFI = IPCHAR(IP+1) IL1 = IFI - ID IF (IL1.EQ.20) THEN IF (CHAI1.EQ.ICHARA(ID:ID+19)) THEN TYPOBJ = MTAB1.MTABTV(K) IF (TYPOBJ.EQ.'FLOTTANT') THEN XPALA(I,K1) = MTAB1.RMTABV(K) ENDIF ENDIF ELSE IF (IL1.EQ.18) THEN IF (CHAI2.EQ.ICHARA(ID:ID+17)) THEN TYPOBJ = MTAB1.MTABTV(K) IF (TYPOBJ.EQ.'FLOTTANT') THEN RD = MTAB1.RMTABV(K) XPALA(I,K1+1) = RD ENDIF ENDIF ELSE IF (IL1.EQ.15) THEN IF (CHAI3.EQ.ICHARA(ID:ID+14)) THEN TYPOBJ = MTAB1.MTABTV(K) IF (TYPOBJ.EQ.'FLOTTANT') THEN XPALA(I,K1+2) = MTAB1.RMTABV(K) ENDIF ENDIF ELSE IF (IL1.EQ.16) THEN IF (CHAI4.EQ.ICHARA(ID:ID+15)) THEN TYPOBJ = MTAB1.MTABTV(K) IF (TYPOBJ.EQ.'FLOTTANT') THEN XPALA(I,K1+3) = MTAB1.RMTABV(K) ENDIF ENDIF ELSE IF (IL1.EQ.14) THEN IF (CHAI5.EQ.ICHARA(ID:ID+13)) THEN TYPOBJ = MTAB1.MTABTV(K) IF (TYPOBJ.EQ.'FLOTTANT') THEN RV = MTAB1.RMTABV(K) XPALA(I,K1+4) = RV ENDIF ENDIF ELSE IF (IL1.EQ.11) THEN IF (CHAI6.EQ.ICHARA(ID:ID+10)) THEN TYPOBJ = MTAB1.MTABTV(K) IF (TYPOBJ.EQ.'FLOTTANT') THEN XPALA(I,K1+5) = MTAB1.RMTABV(K) ENDIF ENDIF ENDIF ENDIF 30 CONTINUE ND = INT(RD/XPDTS2) + 1 NV = INT(RV/XPDTS2) + 2 NMAX = MAX(ND,NV) K1 = K1 + 6 + NMAX ENDIF ENDIF 20 CONTINUE if(nbesc.ne.0)segdes ipiloc SEGDES MTABLE * * Nombre de modes "origine" * IPALA(I,2) = K2 - 1 * * --------- choc ........... * * ELSE IF (CMOT(1: ).EQ.' ') THEN * ....... * ....... * ELSE CALL ERREUR(490) RETURN ENDIF * * Liaison ........... * * ELSE IF (MONMOT(1: ).EQ.' ') THEN * ....... * ....... * ELSE CALL ERREUR(489) RETURN ENDIF 10 CONTINUE * * * * ----- liaisons conditionnelles ? * * DO 11 I = 1,NLIAA ksi = 0 CALL ACCTAB(ILIA,'ENTIER',I,X0,' ',L0,IP0, & 'TABLE',I0,X0,' ',L1,ITLIAI) DO 111 j = 1,NLIAA jtliai = icorres ( j ) monmot = ' ' CALL ACCTAB(ITLIAI,'TABLE',I0,x0,' ',L0,jtliai, & monmot,I1,X0,CHARRE,L1,IP1) IF (IERR.NE.0) RETURN * ------- si on trouve un logique en face d'une table * de liaison , c'est bon IF (MONMOT.EQ.'LOGIQUE ') THEN ksi = ksi + 1 ipala(i,2) = 1 IF (L1 ) tHEN ipala (i,3+ksi) = j ELSE IF (.NOT. L1) THEN ipala (i,3+ksi) = -1 * j ENDIF ENDIF 111 CONTINUE 11 CONTINUE * * * * * end do IF (IIMPI.EQ.333) THEN DO 1000 IN = 1,NLIAA DO 1002 II = 1,NIPALA WRITE(IOIMP,*)'DYNE19 : IPALA(',IN,',',II,') =',IPALA(IN,II) 1002 CONTINUE DO 1004 IX = 1,NXPALA WRITE(IOIMP,*)'DYNE19 : XPALA(',IN,',',IX,') =',XPALA(IN,IX) 1004 CONTINUE DO 1006 IP = 1,NPLAA WRITE(IOIMP,*)'DYNE19 : IPLIA(',IN,',',IP,') =',IPLIA(IN,IP) 1006 CONTINUE 1000 CONTINUE DO 1008 IP = 1,NPLA WRITE(IOIMP,*)'DYNE19 : JPLIA(',IP,') =',JPLIA(IP) 1008 CONTINUE ENDIF * END