C OPERIN SOURCE CB215821 20/11/25 13:35:27 10792 ************************************************************************ * NOM : ENTI * DESCRIPTION : Convertit si possible un objet en nombre entier ************************************************************************ * APPELE PAR : pilot.eso ************************************************************************ * ENTREES :: aucune * SORTIES :: aucune ************************************************************************ * SYNTAXE (GIBIANE) : * * OBJ2 = ENTI (|'TRONCATURE'|) OBJ1 ; * |'INFERIEUR' | * |'SUPERIEUR' | * |'PROCHE' | * ************************************************************************ SUBROUTINE OPERIN IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMLENTI -INC SMLREEL -INC SMLMOTS -INC SMCHPOI * CHARACTER*8 CHA8 CHARACTER*32 CH32 * PARAMETER (NBRTYP=6) CHARACTER*8 LISTYP(NBRTYP) DATA LISTYP/'ENTIER','FLOTTANT','LISTREEL','CHPOINT','MOT', & 'LISTMOTS'/ * PARAMETER (NBROPT=4) CHARACTER*4 LISOPT(NBROPT) DATA LISOPT/'TRON','INFE','SUPE','PROC'/ * * * LECTURE DU TYPE DE CONVERSION CALL LIRMOT(LISOPT,NBROPT,NUMOPT,0) IF (NUMOPT.EQ.0) NUMOPT=1 * * LECTURE DU TYPE D'OBJET A CONVERTIR CALL QUETYP(CHA8,1,IRETOU) IF (IERR.NE.0) RETURN CALL PLACE(LISTYP,NBRTYP,NUMTYP,CHA8) IF (NUMTYP.EQ.0) THEN * "On ne veut pas d'objet de type %m1:8" MOTERR(1:8)=CHA8 CALL ERREUR(39) RETURN ENDIF * * * * +---------------------------------------------------------------+ * | O B J E T = E N T I E R | * +---------------------------------------------------------------+ * IF (NUMTYP.EQ.1) THEN CALL LIRENT(IVAL1,1,IRETOU) IF (IERR.NE.0) RETURN * CALL ECRENT(IVAL1) * RETURN * * * * +---------------------------------------------------------------+ * | O B J E T = F L O T T A N T | * +---------------------------------------------------------------+ * ELSEIF (NUMTYP.EQ.2) THEN CALL LIRREE(XVAL1,1,IRETOU) IF (IERR.NE.0) RETURN * IF (NUMOPT.EQ.1) THEN IVAL1=INT(XVAL1) ELSEIF (NUMOPT.EQ.2) THEN IVAL1=FLOOR(XVAL1) ELSEIF (NUMOPT.EQ.3) THEN IVAL1=CEILING(XVAL1) ELSEIF (NUMOPT.EQ.4) THEN IVAL1=NINT(XVAL1) ENDIF * CALL ECRENT(IVAL1) * RETURN * * * * +---------------------------------------------------------------+ * | O B J E T = L I S T R E E L | * +---------------------------------------------------------------+ * ELSEIF (NUMTYP.EQ.3) THEN CALL LIROBJ(CHA8,MLREEL,1,IRETOU) IF (IERR.NE.0) RETURN * SEGACT,MLREEL JG=PROG(/1) SEGINI,MLENTI * IF (NUMOPT.EQ.1) THEN DO 10 I=1,JG LECT(I)=INT(PROG(I)) 10 CONTINUE ELSEIF (NUMOPT.EQ.2) THEN DO 11 I=1,JG LECT(I)=FLOOR(PROG(I)) 11 CONTINUE ELSEIF (NUMOPT.EQ.3) THEN DO 12 I=1,JG LECT(I)=CEILING(PROG(I)) 12 CONTINUE ELSEIF (NUMOPT.EQ.4) THEN DO 13 I=1,JG LECT(I)=NINT(PROG(I)) 13 CONTINUE ENDIF * SEGDES,MLREEL,MLENTI * CALL ECROBJ('LISTENTI',MLENTI) * RETURN * * * * +---------------------------------------------------------------+ * | O B J E T = C H P O I N T | * +---------------------------------------------------------------+ * ELSEIF (NUMTYP.EQ.4) THEN CALL LIROBJ(CHA8,MCHPOI,1,IRETOU) IF (IERR.NE.0) RETURN * SEGINI,MCHPO1=MCHPOI NSOUPO=MCHPO1.IPCHP(/1) DO 20 I=1,NSOUPO MSOUPO=MCHPO1.IPCHP(I) SEGINI,MSOUP1=MSOUPO MCHPO1.IPCHP(I)=MSOUP1 * MPOVAL=MSOUP1.IPOVAL SEGINI,MPOVA1=MPOVAL MSOUP1.IPOVAL=MPOVA1 * N=MPOVA1.VPOCHA(/1) NC=MPOVA1.VPOCHA(/2) IF (NUMOPT.EQ.1) THEN DO 210 J=1,NC DO 220 K=1,N MPOVA1.VPOCHA(K,J)=INT(MPOVA1.VPOCHA(K,J)) 220 CONTINUE 210 CONTINUE ELSEIF (NUMOPT.EQ.2) THEN DO 230 J=1,NC DO 240 K=1,N MPOVA1.VPOCHA(K,J)=FLOOR(MPOVA1.VPOCHA(K,J)) 240 CONTINUE 230 CONTINUE ELSEIF (NUMOPT.EQ.3) THEN DO 250 J=1,NC DO 260 K=1,N MPOVA1.VPOCHA(K,J)=CEILING(MPOVA1.VPOCHA(K,J)) 260 CONTINUE 250 CONTINUE ELSEIF (NUMOPT.EQ.4) THEN DO 270 J=1,NC DO 280 K=1,N MPOVA1.VPOCHA(K,J)=NINT(MPOVA1.VPOCHA(K,J)) 280 CONTINUE 270 CONTINUE ENDIF * SEGDES,MSOUP1,MPOVA1 20 CONTINUE * SEGDES,MCHPO1 * CALL ECROBJ('CHPOINT',MCHPO1) * RETURN * * * * +---------------------------------------------------------------+ * | O B J E T = M O T | * +---------------------------------------------------------------+ * ELSEIF (NUMTYP.EQ.5) THEN CALL LIRCHA(CH32,1,IRETOU) IF (IERR.NE.0) RETURN * WRITE(CHA8,FMT='("(I",I2,")")') IRETOU READ(CH32(1:IRETOU),FMT=CHA8,IOSTAT=IOS) IVAL1 IF (IOS.NE.0) THEN WRITE(CHA8,FMT='("(F",I2,".0)")') IRETOU READ(CH32(1:IRETOU),FMT=CHA8,ERR=999) XVAL1 IF (NUMOPT.EQ.1) THEN IVAL1=INT(XVAL1) ELSEIF (NUMOPT.EQ.2) THEN IVAL1=FLOOR(XVAL1) ELSEIF (NUMOPT.EQ.3) THEN IVAL1=CEILING(XVAL1) ELSEIF (NUMOPT.EQ.4) THEN IVAL1=NINT(XVAL1) ENDIF ENDIF * CALL ECRENT(IVAL1) * RETURN * * * * +---------------------------------------------------------------+ * | O B J E T = L I S T M O T S | * +---------------------------------------------------------------+ * ELSEIF (NUMTYP.EQ.6) THEN CALL LIROBJ('LISTMOTS',MLMOTS,1,IRETOU) IF (IERR.NE.0) RETURN * SEGACT MLMOTS JG=MOTS(/2) SEGINI MLENTI * IF (NUMOPT.EQ.1) THEN DO 30 I=1,JG READ(MOTS(I),FMT='(I4)',IOSTAT=IOS) LECT(I) IF (IOS.NE.0) THEN READ(MOTS(I),FMT='(F4.0)',ERR=999) XVAL1 LECT(I)=INT(XVAL1) ENDIF 30 CONTINUE ELSEIF (NUMOPT.EQ.2) THEN DO 31 I=1,JG READ(MOTS(I),FMT='(I4)',IOSTAT=IOS) LECT(I) IF (IOS.NE.0) THEN READ(MOTS(I),FMT='(F4.0)',ERR=999) XVAL1 LECT(I)=FLOOR(XVAL1) ENDIF 31 CONTINUE ELSEIF (NUMOPT.EQ.3) THEN DO 32 I=1,JG READ(MOTS(I),FMT='(I4)',IOSTAT=IOS) LECT(I) IF (IOS.NE.0) THEN READ(MOTS(I),FMT='(F4.0)',ERR=999) XVAL1 LECT(I)=CEILING(XVAL1) ENDIF 32 CONTINUE ELSEIF (NUMOPT.EQ.4) THEN DO 33 I=1,JG READ(MOTS(I),FMT='(I4)',IOSTAT=IOS) LECT(I) IF (IOS.NE.0) THEN READ(MOTS(I),FMT='(F4.0)',ERR=999) XVAL1 LECT(I)=NINT(XVAL1) ENDIF 33 CONTINUE ENDIF * SEGDES,MLMOTS,MLENTI * CALL ECROBJ('LISTENTI',MLENTI) * RETURN ENDIF * * * * /!\ ERREUR LORS DE LA CONVERSION MOT=>FLOTTANT 999 CALL ERREUR(21) RETURN * END *