1 : C RNGCHA SOURCE FANDEUR 10/12/14 21:19:23 6812
2 :
3 : SUBROUTINE RNGCHA(IPCHA1,IPCHA2,TCHA1,TCHA2,IPCHE1,IPCHE2)
4 :
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8(A-H,O-Z)
7 :
8 : *--------------------------------------------------------------------*
9 : * *
10 : * A partir de 2 pointeurs MCHAML dans un ordre quelconque, *
11 : * RNGCHA retourne 2 pointeurs connus sur 2 types de MCHAML *
12 : * specifies s'ils sont presents. *
13 : * *
14 : *--------------------------------------------------------------------*
15 : * *
16 : * Entr{es: *
17 : * *
18 : * IPCHA1 pointeur sur un MCHAML inconnu *
19 : * IPCHA2 pointeur sur un MCHAML inconnu *
20 : * TCHA1 TITRE (TITCHE ) DU MCHAML a mettre en premiere *
21 : * position s'il est present. *
22 : * TCHA2 TITRE (TITCHE ) DU MCHAML a mettre en seconde *
23 : * position s'il est present. *
24 : * *
25 : * Sorties: *
26 : * *
27 : * IPCHE1 pointeur sur le MCHAML du premier type specifie *
28 : * s'il est pr{sent. *
29 : * IPCHE2 pointeur sur le MCHAML du second type specifie *
30 : * s'il est pr{sent. *
31 : *--------------------------------------------------------------------*
32 : *
33 : -INC CCOPTIO
34 : -INC SMCHAML
35 : *
36 : CHARACTER*(*) TCHA1,TCHA2
37 : CHARACTER*72 TITCH1,TITCH2,TCHAM1,TCHAM2
38 : *
39 : IPCHE1=0
40 : IPCHE2=0
41 : TITCH1 = ' '
42 : TITCH2 = ' '
43 : TCHAM1 = TCHA1
44 : TCHAM2 = TCHA2
45 : *
46 : IF (IPCHA1.NE.0) THEN
47 : MCHELM=IPCHA1
48 : SEGACT MCHELM
49 : TITCH1=TITCHE
50 : IF (TITCH1.EQ.TCHAM1) THEN
51 : IPCHE1=IPCHA1
52 : ELSE IF (TITCH1.EQ.TCHAM2) THEN
53 : IPCHE2=IPCHA1
54 : ENDIF
55 : SEGDES MCHELM
56 : ENDIF
57 : *
58 : IF (IPCHA2.NE.0) THEN
59 : MCHELM=IPCHA2
60 : SEGACT MCHELM
61 : TITCH2=TITCHE
62 : IF (TITCH2.EQ.TCHAM1) THEN
63 : IPCHE1=IPCHA2
64 : ELSE IF (TITCH2.EQ.TCHAM2) THEN
65 : IPCHE2=IPCHA2
66 : ENDIF
67 : SEGDES MCHELM
68 : ENDIF
69 : *
70 : * LES 2 MCHAMLS SONT DE MEME TYPE
71 : *
72 : IF (TITCH1.EQ.TITCH2) THEN
73 : MOTERR(1:8)='MCHAML '
74 : MOTERR(9:16)=TITCH1
74 : CALL ERREUR(130)
75 : *
76 : * PAS DE MCHAML TROUVE
77 : *
78 : ELSE IF (IPCHE1.EQ.0.AND.IPCHE2.EQ.0) THEN
79 : MOTERR(1:8)='MCHAML '
80 : MOTERR(9:16)=TITCH1
80 : CALL ERREUR(131)
81 : ENDIF
82 : *
83 : RETURN
84 : END
85 :
86 :
© Cast3M 2003 - All rights reserved.
Disclaimer