C ELLA01 SOURCE CHAT 05/01/12 23:33:44 5004 SUBROUTINE ELLA01(NELEXP,NP2,NFRQ,ITEXP,MATRES) C IMPLICIT INTEGER(I-N) -INC SMLREEL -INC SMTABLE -INC SMELEME C POINTEUR MLREE4.MLREEL,MLREE5.MLREEL C C LECTURE DE LA TABLE DES ELEMENTS EXPERIMENTAUX C C MODULE DECODANT DES LISTES REELLES DE COEFFICIENTS C EXPERIMENTAUX C C TEXP = TABLE 'TAB_EXPERIMENTALE' ; C C TLT . MAILLAGE = TABLE 'ELEMENT_EXPERIMENTAL' ; C TEXP . MAILLAGE = TLT(JELEM) ; C C LA LONGUEUR DE LA TABLE TEXP EST EGALE A : C 1 + NOMBRE D'ELEMENTS EXPERIMENTAUX C C POINTEUR DE MOT : MTABII(1) C POINTEUR DE MAILLAGE DU 1 ER MAILLAGE EXPERIMENTAL : MTABII(2) C POINTEUR DE MAILLAGE DU 2 EME MAILLAGE EXPERIMENTAL : MTABII(3) C POINTEUR DE MAILLAGE DU JELEM EME MAILLAGE EXPERIMENTAL : MTABII(JTAB) C C POINTEUR DE TABLE DU 1 ER MAILLAGE EXPERIMENTAL : MTABIV(2) C POINTEUR DE TABLE DU 2 EME MAILLAGE EXPERIMENTAL : MTABIV(3) C POINTEUR DE TABLE DU JELEM EME MAILLAGE EXPERIMENTAL : MTABIV(JTAB) C C 1 < JLIGNE < 14 C TE(JELEM)L(JLIGN) = TABLE 'LIGNE' ; C TLT(JELEM) . JLIGN = TE(JELEM)L(JLIGN) ; C C 1 < JCOLO < 28 C 1 -> RUXA : PARTIE REELLE DE UXA C 2 -> RUYA C ......... C JCOLO -> COMP(JCOLO) C ......... C 28 -> RQTB C 29 -> IUXA : PARTIE IMAGINAIRE DE UXA C ......... C JCOLO+28 -> COMP(JCOLO+28) C ......... C 56 -> IQTB C C ENTREES : C - NELEXP : NOMBRE D'ELEMENTS EXPERIMENTAUX C - NFRQ : NOMBRE DE POINTS EN FREQUENCE C - ITEXP : POINTEUR DE LA TABLE : TEXP C C SORTIES : C - MATRES : SEGMENT OU L'ON REMPLIT ALPHAI C C VARIABLES LOCALES : C - PARREE : PARTIE REELLE C - PARIMA : PARTIE IMAGINAIRE C POINTEURS : C - ITAB1 : POINTEUR DE TEXP . MAILLAGE C - ITAB2 : POINTEUR DE TEXP . MAILLAGE. JLIGN C - IPOLI1 : POINTEUR DE LISTE REELLE : PARTIE REELLE C - IPOLI2 : POINTEUR DE LISTE REELLE : PARTIE IMAGINAIRE C CHARACTER*4 COMP(56) CHARACTER*8 CHARI,CHARR,MTYPR LOGICAL LOGII,LOGIR REAL*8 PARREE,PARIMA,X0,X1,X2 INTEGER ITEXP,ITAB1,ITAB2,IPOLI1,IPOLI2 C SEGMENT MATRES COMPLEX*16 ZA1 (NP28,NP28) COMPLEX*16 ZSM (NP28) COMPLEX*16 ZXX (NP28) COMPLEX*16 ZSOL (NNT14,NFRQ) REAL*8 COOR (3 ,NP2) REAL*8 GAMA (3 ,NP) REAL*8 CARACT(10,NP) REAL*8 XCL (17 ,NNT) REAL*8 XCOR (2 , 3 , NBELEM ) REAL*8 VALDE1(2 , NBELEM , 3 ) REAL*8 VALDE2(2 , NBELEM , 3 ) REAL*8 VALDE3(2 , NBELEM , 1 ) REAL*8 VALDE4(2 , NBELEM , 1 ) INTEGER FLAG (NNT17) INTEGER CORRES(NP2) INTEGER NUMERO(NNT) INTEGER MASS (4,NNT) REAL*8 RMAS (4,NNT) INTEGER IRAILO(4,NNT) REAL*8 VALRAI(6,NNT) INTEGER IPIVO(NP28) INTEGER JPIVO(NP28) INTEGER IAUX(NP28) INTEGER IEXPER(NP) COMPLEX*16 ALPHAI(14,28,NP,NFRQ) ENDSEGMENT C DATA COMP/'RUXA','RUYA','RUZA','RRXA','RRYA','RRZA', & 'RFXA','RFYA','RFZA','RMXA','RMYA','RMZA','RPRA','RQTA', & 'RUXB','RUYB','RUZB','RRXB','RRYB','RRZB', & 'RFXB','RFYB','RFZB','RMXB','RMYB','RMZB','RPRB','RQTB', & 'IUXA','IUYA','IUZA','IRXA','IRYA','IRZA', & 'IFXA','IFYA','IFZA','IMXA','IMYA','IMZA','IPRA','IQTA', & 'IUXB','IUYB','IUZB','IRXB','IRYB','IRZB', & 'IFXB','IFYB','IFZB','IMXB','IMYB','IMZB','IPRB','IQTB'/ C C INITIALISATION C CHARI=' ' CHARR=' ' C C MTAB1=ITEXP C SEGACT MTAB1 C LONTAB=MTAB1.MLOTAB C DO 10 JTAB = 2,LONTAB C C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . MAILLAGE : ITAB1 C IPT5=MTAB1.MTABII(JTAB) SEGACT IPT5 C C NOMBRE DE TUYAUX DANS LE MELEME C NBEL=IPT5.NUM(/2) C C NUMERO DES NOEUDS CONSTITUANT L'ELEMENT POINTE C INU1=IPT5.NUM(1,NBEL) INU2=IPT5.NUM(2,NBEL) C C RECHERCHE DU NUMERO DE L'ELEMENT EXPERIMENTAL C DO 100 III=1,NP2,2 C IN1=MATRES.CORRES(III) IN2=MATRES.CORRES(III+1) C IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN NUMEXP=INT(III/2) + 1 END IF C IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN NUMEXP=INT(III/2) + 1 END IF C 100 CONTINUE C SEGDES IPT5 C C 1 < INP < NP2 C IEXPER(INP) = 0 : TUYAU FORMULATION INTEGRALE C IEXPER(INP) = 1 : TUYAU FORMULATION EXPERIMENTALE C IEXPER(INP) EST MIS A EGAL A 1 SI UNIQUEMENT LE MOT VECT EST C DECODE DANS LE CHAMP DE CARACTERISTIQUES C IF (IEXPER(NUMEXP).NE.0) THEN ITAB1=MTAB1.MTABIV(JTAB) END IF C IF (ITAB1.NE.0) THEN C C LE NOM D'UN COMPOSANT EXPERIMENTAL A ETE DETECTE C DO 20 JLIGN=1,14 C C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . MAILLAGE . JLIGN : ITAB2 C CALL ACCTAB(ITAB1,'ENTIER',JLIGN,X0,CHARI,LOGII,IP0, & 'TABLE',I1,X1,CHARR,LOGIR,ITAB2) C IF (ITAB2.NE.0) THEN DO 30 JCOLO=1,28 C C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . JELEM . JLIGN . C COMP(JCOLO) : IPOLI1 -> CORRESPOND A LA PARTIE REELLE C MTYPR=' ' CALL ACCTAB(ITAB2,'MOT',I0,X0,COMP(JCOLO),LOGII,IP0, & MTYPR,I1,X1,CHARR,LOGIR,IPOLI1) IF (MTYPR.EQ.'LISTREEL') THEN C C LA PARTIE REELLE NON NULLE : C RECHERCHE DE LA VALEUR DU POINTEUR TEXP . JELEM . JLIGN . C COMP(JCOLO+28) : IPOLI2 -> CORRESPOND A LA PARTIE IMAGINAIRE C MTYPR=' ' CALL ACCTAB(ITAB2,'MOT',I0,X0,COMP(JCOLO+28),LOGII,IP0, & MTYPR,I1,X1,CHARR,LOGIR,IPOLI2) IF (MTYPR.EQ.'LISTREEL') THEN C C LA PARTIE IMAGINAIRE EST NON NULLE C MLREE4=IPOLI1 MLREE5=IPOLI2 SEGACT MLREE4 SEGACT MLREE5 DO 40 JFRQ=1,NFRQ PARREE=MLREE4.PROG(JFRQ) PARIMA=MLREE5.PROG(JFRQ) C MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)=CMPLX(PARREE, & PARIMA) 40 CONTINUE SEGDES MLREE4 SEGDES MLREE5 C ELSE C PARIMA=0.D0 MLREEL=IPOLI1 SEGACT MLREEL DO 50 JFRQ=1,NFRQ PARREE=PROG(JFRQ) C MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)= & CMPLX(PARREE,PARIMA) C 50 CONTINUE SEGDES MLREEL C END IF ELSE C C LA PARTIE REELLE EST NULLE C PARREE=0.D0 MTYPR=' ' CALL ACCTAB(ITAB2,'MOT',I0,X0,COMP(JCOLO+28),LOGII,IP0, & MTYPR,I1,X1,CHARR,LOGIR,IPOLI2) IF (MTYPR.EQ.'LISTREEL') THEN C C LA PARTIE IMAGINAIRE EST NON NULLE C MLREEL=IPOLI2 SEGACT MLREEL DO 60 JFRQ=1,NFRQ PARIMA=PROG(JFRQ) C MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)= & CMPLX(PARREE,PARIMA) 60 CONTINUE SEGDES MLREEL C ELSE C C LA PARTIE IMAGINAIRE EST NULLE C PARIMA=0.D0 DO 70 JFRQ=1,NFRQ MATRES.ALPHAI(JLIGN,JCOLO,NUMEXP,JFRQ)= & CMPLX(PARREE,PARIMA) 70 CONTINUE C END IF C END IF C 30 CONTINUE C END IF 20 CONTINUE C END IF 10 CONTINUE C SEGDES MTAB1 C RETURN C end