C LIRRES SOURCE GF238795 18/02/01 21:15:57 9724 SUBROUTINE LIRRES(ILCHP1,ICODE1,ITYPE1,NOM1,NCHPO1,ITEMP1,ILREE1) ************************************************************************ * NOM : LIRRES * DESCRIPTION : Cherche a lire un "signal instationnaire" dans la pile * des objets sous la forme generique d'un LISTCHPO ou * a partir de tables resultats de calculs (PASAPAS, EXEC, * DYNAMIC...) ************************************************************************ * APPELE PAR : pod.eso ; evpjba.eso ; pjblch.eso ************************************************************************ * ENTREES : ICODE1 = entier valant 1 si la lecture est obligatoire ou * 0 si la lecture est facultative * ITYPE1 = type d'objet recherche : * 0 pour chercher tous les types * 1 pour chercher un LISTCHPO * 2 pour chercher une table PASAPAS * 3 pour chercher une DYNAMIC * 4 pour chercher une EXEC * ITEMP1 = entier valant 1 si la liste des temps doit etre * renvoyee dans ILREE1 * SORTIES : ILCHP1 = pointeur vers l'objet LISTCHPO contenant le signal * instationnaire * ITYPE1 = code de sortie valant : * 0 si aucun objet trouve * 1 si objet LISTCHPO trouve * 2 si table PASAPAS trouvee * 3 si table DYNAMIC trouvee * 4 si table EXEC trouvee * NOM1 = nom de l'inconnue, si definie * NCHPO1 = nombre d'objets CHPOINT (= pas de temps) contenus * dans ILCHP1 (forcement positif, sinon erreur) * ILREE1 = pointeur vers l'objet LISTREEL contenant le temps * (vaut 0 si ITEMP1=0) * ************************************************************************ * SYNTAXE (GIBIANE) : * * (...) = ???? | LCHPO1 LREEL1 | (LIPDT1) (...) ; * | TAB1 (MOT1) | * * (LREEL1 n'est pas requis dans le cas ou ITEMP1=0) * ************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMTABLE -INC SMLCHPO -INC SMLENTI -INC SMLREEL * PARAMETER (NTYP=3) CHARACTER*8 MTYP(NTYP) DATA MTYP/'PASAPAS','DYNAMIC','EQEX'/ * CHARACTER*8 CHA8,CHB8 LOGICAL ZLOGI * CHARACTER*32 NOM1 * * IIDX = LISTE DES NCH PAS DE TEMPS RETENUS DANS LE SIGNAL INITIAL SEGMENT/TIDX/(IIDX(NCH)) * * TRAV1 = SEGMENT DE TRAVAIL UTILISE LORS D'UN APPEL A ORDO SEGMENT TRAV1 INTEGER ITRA((NTRA+1)/2) ENDSEGMENT * ************************************************************************ * * ITYPO1=ITYPE1 cGF test de ITIPE1 >> remplacement ITYPE1, on soupconne une typo IF (ITYPE1.GT.0) THEN ICODE2=ICODE1 ELSE ICODE2=0 ENDIF * ILREE1=0 I0=0 NOM1=' ' * * * **************************************************************** * SIGNAL D'ENTREE DEJA SOUS LA FORME D'UN COUPLE LISTCHPO/LISTREEL * **************************************************************** IF (ITYPO1.EQ.0.OR.ITYPO1.EQ.1) THEN CALL LIROBJ('LISTCHPO',ILCHP1,ICODE2,IRET) IF (IRET.EQ.0) GOTO 1 MLCHPO=ILCHP1 SEGACT,MLCHPO NCH=ICHPOI(/1) ITYPE1=1 * * (+ recuperation de la liste temporelle) IF (ITEMP1.GT.0) THEN * Le LISTREEL doit etre juste derriere le LISTCHPO (car on * pourrait aussi en trouver un autre plus loin) => test QUETYP CALL QUETYP(CHA8,0,IRET) IF (IRET.EQ.0.OR.CHA8.NE.'LISTREEL') THEN MOTERR(1:8)='LISTREEL' CALL ERREUR(37) RETURN ENDIF CALL LIROBJ('LISTREEL',ILREE1,1,IRET) MLREEL=ILREE1 SEGACT,MLREEL IF (PROG(/1).NE.NCH) THEN CALL ERREUR(212) RETURN ENDIF NCH=ICHPOI(/1) ENDIF * GOTO 2 ENDIF * * * **************************************************************** * SI C'EST UNE TABLE : ON RECHERCHE L'INDICE CONTENANT LA VARIABLE * DEMANDEE PAR L'UTILISATEUR (PAR DEFAUT LE * DEPLACEMENT EN MECA. SOLIDE, LA VITESSE EN * MECA. FLUIDE) * **************************************************************** 1 CONTINUE IF (ITYPO1.EQ.1) GOTO 3 CALL LIROBJ('TABLE',ITAB1,0,IRET) IF (IRET.EQ.0) GOTO 3 * * RECHERCHE DU SOUS-TYPE DE LA TABLE ITYP=0 CHA8=' ' CALL ACCTAB(ITAB1,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0, & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2) IF (CHA8.EQ.'MOT') CALL PLACE(MTYP,NTYP,ITYP,CHB8) IF (ITYP.EQ.0) THEN MOTERR(1:8)='TABLE' CALL ERREUR(302) RETURN ENDIF * ITYPE1=ITYP+1 IF (ITYPO1.GT.0.AND.ITYPE1.NE.ITYPO1) GOTO 3 * * RECUPERATION EVENTUELLE DU NOM DE L'INDICE CALL QUETYP(CHA8,1,IRET) IF (IERR.NE.0) RETURN LNOM1=0 IF (CHA8.EQ.'MOT') CALL LIRCHA(NOM1,1,LNOM1) * * * CAS D'UNE TABLE PASAPAS * ======================= IF (ITYPE1.EQ.2) THEN IF (LNOM1.EQ.0) NOM1='DEPLACEMENTS' I0=1 * CHA8=' ' CALL ACCTAB(ITAB1,'MOT',0,0.D0,NOM1,.TRUE.,0, & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2) IF (CHA8.NE.'TABLE') GOTO 9 MTABLE=ITAB2 SEGACT,MTABLE NCH=MLOTAB * * (+ recuperation de la liste temporelle) IF (ITEMP1.GT.0) THEN CHA8=' ' CALL ACCTAB(ITAB1,'MOT',0,0.D0,'TEMPS',.TRUE.,0, & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2) IF (CHA8.NE.'TABLE') GOTO 9 MTAB2=ITAB2 SEGACT,MTAB2 ENDIF * * CAS D'UNE TABLE DYNAMIC * ======================= ELSEIF (ITYPE1.EQ.3) THEN IF (LNOM1.EQ.0) NOM1='DEPL' * CHA8=' ' CALL ACCTAB(ITAB1,'MOT',0,0.D0,'RESULTATS',.TRUE.,0, & CHA8,IVAL,XVAL,CHB8,ZLOGI,ITAB2) IF (CHA8.NE.'TABLE') GOTO 9 MTABLE=ITAB2 SEGACT,MTABLE NCH=MLOTAB * * (+ recuperation de la liste temporelle) IF (ITEMP1.GT.0) THEN CHA8=' ' CALL ACCTAB(ITAB1,'MOT',0,0.D0,'TEMPS_CALCULES',.TRUE.,0, & CHA8,IVAL,XVAL,CHB8,ZLOGI,IOBJ2) IF (CHA8.NE.'LISTREEL') GOTO 9 MLREEL=IOBJ2 SEGACT,MLREEL ENDIF * * CAS D'UNE TABLE EXEC * ==================== ELSEIF (ITYPE1.EQ.4) THEN IF (LNOM1.EQ.0) NOM1='UN' * CHA8=' ' CALL ACMO(ITAB1,'INCO',CHA8,ITAB2) IF (CHA8.NE.'TABLE') GOTO 9 CHA8=' ' CALL ACMO(ITAB2,'HIST',CHA8,ITAB3) IF (CHA8.NE.'TABLE') GOTO 9 CHA8=' ' CALL ACMO(ITAB3,NOM1,CHA8,ILCHP1) IF (CHA8.NE.'LISTCHPO') GOTO 9 MLCHPO=ILCHP1 SEGACT,MLCHPO NCH=ICHPOI(/1) * * (+ recuperation de la liste temporelle) IF (ITEMP1.GT.0) THEN CHA8=' ' CALL ACCTAB(ITAB2,'MOT',0,0.D0,'TPS',.TRUE.,0, & CHA8,IVAL,XVAL,CHB8,ZLOGI,IOBJ2) IF (CHA8.NE.'LISTREEL') GOTO 9 MLREEL=IOBJ2 SEGACT,MLREEL ENDIF * ENDIF * GOTO 2 * * ERREUR : LA TABLE N'A PAS LE FORMAT ATTENDU 9 CONTINUE CALL ERREUR(647) RETURN * * * ************************************************************* * RECUPERATION EVENTUELLE D'UNE LISTE D'INDICES DE PAS DE TEMPS * ************************************************************* 2 CONTINUE * * Le LISTENTI doit etre place precisement ici (car on pourrait * aussi en trouver un autre plus loin) => test QUETYP CALL QUETYP(CHA8,0,IRET) IZIDX=0 IF (IRET.NE.0.AND.CHA8.EQ.'LISTENTI') THEN IZIDX=1 CALL LIROBJ('LISTENTI',MLENT1,1,IRET) IF (IERR.NE.0) RETURN ENDIF * * PAR DEFAUT, ON RETIENT TOUS LES INSTANTS DISPONIBLES IF (IZIDX.EQ.0) THEN SEGINI,TIDX DO I=1,NCH IIDX(I)=I-I0 ENDDO ELSE NCH1=NCH * SEGACT,MLENT1 NCH=MLENT1.LECT(/1) SEGINI,TIDX * * VALIDATION DES VALEURS FOURNIES DANS MLENT1 NCH=0 DO I=1,MLENT1.LECT(/1) IVAL=MLENT1.LECT(I) IF (IVAL.GE.1.AND.IVAL.LE.NCH1) THEN NCH=NCH+1 IIDX(NCH)=IVAL ENDIF ENDDO SEGDES,MLENT1 * * TRI PAR ORDRE CROISSANT NTRA=NCH SEGINI,TRAV1 CALL ORDM02(IIDX(1),NCH,ITRA(1),.TRUE.) SEGSUP,TRAV1 * * SUPPRESSION DES DOUBLONS NDOUB=0 DO I=2,NCH IF (IIDX(I-1).NE.IIDX(I)) THEN IF (NDOUB.GT.0) IIDX(I-NDOUB)=IIDX(I) ELSE NDOUB=NDOUB+1 ENDIF ENDDO NCH=NCH-NDOUB SEGADJ,TIDX ENDIF * IF (NCH.EQ.0) THEN WRITE(IOIMP,*) 'Le signal fourni est vide' CALL ERREUR(21) RETURN ENDIF * * * ******************************************************** * OBTENTION DES OBJETS LISTREEL ET LISTCHPO RESTREINTS AUX * INSTANTS DE IIDX * ******************************************************** * * SYNTAXES 1 (LISTCHPO/LISTREEL) ET 4 (PROCEDURE "EXEC") * ====================================================== IF (IZIDX.NE.0.AND.(ITYPE1.EQ.1.OR.ITYPE1.EQ.4)) THEN * MLCHP1=MLCHPO N1=NCH SEGINI,MLCHPO DO I=1,NCH ICHPOI(I)=MLCHP1.ICHPOI(IIDX(I)) ENDDO SEGDES,MLCHP1 * IF (ITEMP1.GT.0) THEN MLREE1=MLREEL JG=NCH SEGINI,MLREEL DO I=1,NCH PROG(I)=MLREE1.PROG(IIDX(I)) ENDDO ENDIF SEGDES,MLREE1 * * SYNTAXE 2 (PROCEDURE "PASAPAS") * =============================== ELSEIF (ITYPE1.EQ.2) THEN * N1=NCH SEGINI,MLCHPO DO I=1,NCH IDX1=IIDX(I) CALL ACCTAB(MTABLE,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0, & 'CHPOINT',IVAL,XVAL,CHA8,ZLOGI,ICHP1) IF (IERR.NE.0) RETURN ICHPOI(I)=ICHP1 ENDDO SEGDES,MTABLE * IF (ITEMP1.GT.0) THEN JG=NCH SEGINI,MLREEL DO I=1,NCH IDX1=IIDX(I) CALL ACCTAB(MTAB2,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0, & 'FLOTTANT',IVAL,XT1,CHA8,ZLOGI,IP1) IF (IERR.NE.0) RETURN PROG(I)=XT1 ENDDO SEGDES,MTAB2 ENDIF * * SYNTAXE 3 (PROCEDURE "DYNAMIC") * =============================== ELSEIF (ITYPE1.EQ.3) THEN * N1=NCH SEGINI,MLCHPO DO I=1,NCH IDX1=IIDX(I) CALL ACCTAB(MTABLE,'ENTIER',IDX1,0.D0,'MOT',.TRUE.,0, & 'TABLE',IVAL,XVAL,CHA8,ZLOGI,ITAB1) IF (IERR.NE.0) RETURN CHA8='CHPOINT' CALL ACMO(ITAB1,NOM1,CHA8,ICHP1) IF (IERR.NE.0) RETURN ICHPOI(I)=ICHP1 ENDDO SEGDES,MTABLE * IF (ITEMP1.GT.0.AND.IZIDX.NE.0) THEN MLREE1=MLREEL JG=NCH SEGINI,MLREEL DO I=1,NCH PROG(I)=MLREE1.PROG(IIDX(I)) ENDDO SEGDES,MLREE1 ENDIF * ENDIF * * SEGSUP,TIDX ILCHP1=MLCHPO IF (ITEMP1.GT.0) ILREE1=MLREEL * NCHPO1=NCH RETURN * * * ********************************* * AUCUN OBJET COMPATIBLE N'A ETE LU * ********************************* 3 CONTINUE * ILCHP1=0 ITYPE1=0 * IF (ICODE1.GT.0) THEN WRITE(IOIMP,*) 'Il manque un objet compatible pour definir ', & 'le signal d entree' CALL ERREUR(880) ENDIF * RETURN * END * *