1 : C SIGNE SOURCE CHAT 05/01/13 03:18:04 5004 2 : SUBROUTINE SIGNE 3 : ************************************************************************ 4 : * 5 : * S I G N E 6 : * --------- 7 : * 8 : * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "SIGNE" 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * DONNER LE SIGNE D'UN NOMBRE. 14 : * 15 : * PHRASE D'APPEL (EN GIBIANE): 16 : * ---------------------------- 17 : * 18 : * | (ENTIER) | 19 : * II = SIGNE | | AA ; 20 : * | FLOTTANT | 21 : * 22 : * LES PARENTHESES INDIQUANT UN OPERANDE FACULTATIF. 23 : * 24 : * OPERANDES ET RESULTATS: 25 : * ----------------------- 26 : * 27 : * AA 'FLOTTANT' ) NOMBRE DONT ON CHERCHE LE SIGNE. 28 : * OU 'ENTIER ' ) 29 : * ENTIER 'MOT ' MOT-CLE INDIQUANT QUE LE RESULTAT "II" SERA 30 : * DE TYPE 'ENTIER'. 31 : * FLOTTANT 'MOT ' MOT-CLE INDIQUANT QUE LE RESULTAT "II" SERA 32 : * DE TYPE 'FLOTTANT'. 33 : * II NOMBRE EGAL A +1 OU -1. 34 : * TYPE 'ENTIER' PAR DEFAUT. 35 : * 36 : * SOUS-PROGRAMMES APPELES: 37 : * ------------------------ 38 : * 39 : * LIRE, LIRTYP, ECRIRE. 40 : * 41 : * AUTEUR, DATE DE CREATION: 42 : * ------------------------- 43 : * 44 : * PASCAL MANIGOT 19 FEVRIER 1985 45 : * 46 : * LANGAGE: 47 : * -------- 48 : * 49 : * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS 50 : * 51 : ************************************************************************ 52 : * 53 : IMPLICIT INTEGER(I-N) 54 : -INC CCOPTIO 55 : * 56 : PARAMETER (NBTYPE = 2) 57 : * 58 : * 59 : REAL*8 RSIGNE 60 : CHARACTER*(8) CTYP 61 : * 62 : REAL*8 REELDP 63 : CHARACTER*(8) CMOT 64 : * 65 : * 66 : * LECTURE DU TYPE DU RESULTAT: 67 : ICODE = 0 67 : CALL LIRCHA (CMOT,ICODE,LUMOT) 68 : IF(LUMOT.EQ.0) CMOT ='ENTIER' 69 : IF (LUMOT.NE.0 ) THEN 70 : IF(CMOT.NE.'ENTIER '.AND.CMOT.NE.'FLOTTANT') THEN 70 : CALL REFUS 71 : ENDIF 72 : ENDIF 73 : * 74 : * LECTURE DU NOMBRE: 74 : CALL QUETYP(CTYP,0,IRETOU) 75 : IF(IRETOU.EQ.0) THEN 75 : CALL ERREUR ( 533) 76 : RETURN 77 : ENDIF 77 : IF(CTYP.NE.'ENTIER '.AND.CTYP.NE.'FLOTTANT') CALL ERREUR(15) 78 : IF (IERR .NE. 0) RETURN 79 : ISIGNE=1 80 : IF(CTYP.EQ.'ENTIER ') THEN 80 : CALL LIRENT(IENT,1,IRETOU) 81 : IF(IENT.LT.0) ISIGNE=-1 82 : ELSE 82 : CALL LIRREE(REELDP,1,IRETOU) 83 : IF(REELDP.LT.0D0) ISIGNE=-1 84 : ENDIF 85 : * 86 : IF (CMOT.EQ.'ENTIER ') THEN 86 : CALL ECRENT (ISIGNE) 87 : ELSE 88 : RSIGNE=ISIGNE 88 : CALL ECRREE (RSIGNE) 89 : END IF 90 : * 91 : END 92 :
© Cast3M 2003 - All rights reserved.
Disclaimer