1 : C DIMENS SOURCE GOUNAND 14/01/29 21:15:04 7923
2 : SUBROUTINE DIMENS
3 : ************************************************************************
4 : *
5 : * D I M E N S
6 : * -----------
7 : *
8 : * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "DIMENSION"
9 : *
10 : * FONCTION:
11 : * ---------
12 : *
13 : * FOURNIR LA DIMENSION D'UN OBJET, LA SIGNIFICATION DU MOT
14 : * "DIMENSION" DEPENDANT DE L'OBJET CONSIDERE.
15 : *
16 : * PHRASE D'APPEL (EN GIBIANE):
17 : * ----------------------------
18 : *
19 : * LONG = DIMENSION OBJ ;
20 : *
21 : * OPERANDE ET RESULTAT:
22 : * ---------------------
23 : *
24 : * LONG 'ENTIER ' DIMENSION DE "OBJ".
25 : * OBJ 'LISTREEL' OBJET DONT ON PEUT DEFINIR UNE "DIMENSION".
26 : * OU 'LISTCHPO'
27 : * OU 'RIGIDITE'
28 : * OU 'LISTENTI'
29 : * OU 'SOLUTION'
30 : * OU 'LISTMOTS'
31 : * OU 'TABLE '
32 : * OU 'EVOLUTIO'
33 : * OU 'CHARGEME'
34 : * OU 'NUAGE ' ('COMP' ou 'UPLE')
35 : * OU 'MOT'
36 : *
37 : *
38 : * MODE DE FONCTIONNEMENT:
39 : * -----------------------
40 : *
41 : * APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE D'OBJET DONT ON
42 : * CHERCHE LA DIMENSION.
43 : *
44 : * SOUS-PROGRAMMES APPELES:
45 : * ------------------------
46 : *
47 : * QUETYP,ECRENT,DIMEN1,DIMEN2,DIMEN3,DIMEN4,DIMEN5,DIMEN6
48 : * DIMEN7,DIMEN8,DIMEN9,DIME10
49 : *
50 : * AUTEUR, DATE DE CREATION:
51 : * -------------------------
52 : *
53 : * PASCAL MANIGOT 1ER OCTOBRE 1984
54 : * MODIFIE LE 13 OCTOBRE 1987 PAR DENIS ROBERT
55 : *
56 : * LANGAGE:
57 : * --------
58 : *
59 : * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
60 : *
61 : ************************************************************************
62 : *
63 : IMPLICIT INTEGER(I-N)
64 : IMPLICIT REAL*8(A-H,O-Z)
65 : -INC CCOPTIO
66 : *
67 : CHARACTER*512 CMOT
68 : CHARACTER*4 MOTCLE(2)
69 : DATA MOTCLE/'COMP','UPLE'/
70 : *
71 : 10 CONTINUE
71 : CALL LIROBJ('LISTREEL',IPOINT,0,IRETOU)
72 : IF (IRETOU.NE.1) GOTO 20
72 : CALL DIMEN1 (IPOINT,IDIMEN)
73 : GOTO 5000
74 : 20 CONTINUE
74 : CALL LIROBJ('LISTCHPO',IPOINT,0,IRETOU)
75 : IF (IRETOU.NE.1) GOTO 30
75 : CALL DIMEN2 (IPOINT,IDIMEN)
76 : GOTO 5000
77 : 30 CONTINUE
77 : CALL LIROBJ('RIGIDITE',IPOINT,0,IRETOU)
78 : IF (IRETOU.NE.1) GOTO 40
78 : CALL DIMEN3 (IPOINT,IDIMEN)
79 : GOTO 5000
80 : 40 CONTINUE
80 : CALL LIROBJ('LISTENTI',IPOINT,0,IRETOU)
81 : IF (IRETOU.NE.1) GOTO 50
81 : CALL DIMEN4 (IPOINT,IDIMEN)
82 : GOTO 5000
83 : 50 CONTINUE
83 : CALL LIROBJ('SOLUTION',IPOINT,0,IRETOU)
84 : IF (IRETOU.NE.1) GOTO 60
84 : CALL DIMEN5 (IPOINT,IDIMEN)
85 : GOTO 5000
86 : 60 CONTINUE
86 : CALL LIROBJ('LISTMOTS',IPOINT,0,IRETOU)
87 : IF (IRETOU.NE.1) GOTO 70
87 : CALL DIMEN6 (IPOINT,IDIMEN)
88 : GOTO 5000
89 : 70 CONTINUE
89 : CALL LIROBJ('TABLE ',IPOINT,0,IRETOU)
90 : IF (IRETOU.NE.1) GOTO 80
90 : CALL DIMEN7 (IPOINT,IDIMEN)
91 : GOTO 5000
92 : 80 CONTINUE
92 : CALL LIROBJ('EVOLUTIO',IPOINT,0,IRETOU)
93 : IF (IRETOU.NE.1) GO TO 90
93 : CALL DIMEN8 (IPOINT,IDIMEN)
94 : GO TO 5000
95 : 90 CONTINUE
95 : CALL LIROBJ('CHARGEME',IPOINT,0,IRETOU)
96 : IF (IRETOU.NE.1) GO TO 100
96 : CALL DIMEN9 (IPOINT,IDIMEN)
97 : GO TO 5000
98 : 100 CONTINUE
98 : CALL LIROBJ('NUAGE ',IPOINT,0,IRETOU)
99 : IF (IRETOU.NE.1) GO TO 110
99 : CALL LIRMOT(MOTCLE,2,JEMIL,1)
100 : IF (IERR.NE.0) RETURN
100 : CALL DIME10 (IPOINT,JEMIL,IDIMEN)
101 : GO TO 5000
102 : 110 CONTINUE
102 : CALL LIRCHA(CMOT,0,LMOT)
103 : IF (LMOT.EQ.0) GO TO 666
104 : IDIMEN=LMOT
105 : GO TO 5000
106 : C
107 : C PAS D OPERANDE CORRECTE TROUVE
108 : C
108 : 666 CALL QUETYP(MOTERR(1:8),0,IRETOU)
109 : IF(IRETOU.NE.0) THEN
109 : CALL ERREUR (39)
110 : ELSE
110 : CALL ERREUR(533)
111 : ENDIF
112 : RETURN
113 : *
114 : 5000 CONTINUE
115 : *
115 : CALL ECRENT(IDIMEN)
116 : RETURN
117 : *
118 : END
119 :
120 :
121 :
© Cast3M 2003 - All rights reserved.
Disclaimer