1 : C EXTR11 SOURCE CHAT 05/01/12 23:51:48 5004 2 : SUBROUTINE EXTR11(ICHP,MLMOTS) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *----------------------------------------------------------------------- 6 : * 7 : * E X T R 1 1 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * EXTRAIT LES COMPOSANTES DU CHPOINT "ICHP" ET LES RANGE DANS 14 : * UN LISTMOTS MLMOTS 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC SMCHPOI 20 : -INC SMLMOTS 21 : * 22 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 23 : * ----------- 24 : * 25 : * ICHP (E) POINTEUR SUR LE CHPOINT 26 : * MLMOTS (S) POINTEUR SUR LE LISTMOTS 27 : * 28 : *----------------------------------------------------------------------- 29 : * 30 : * 31 : JGN=4 32 : MCHPOI = ICHP 33 : SEGACT MCHPOI 34 : JGM=0 35 : SEGINI MLMOTS 36 : IF (IPCHP(/1).EQ.0) GO TO 90 37 : DO 10 I=1,IPCHP(/1) 38 : MSOUPO=IPCHP(I) 39 : SEGACT MSOUPO 40 : 10 CONTINUE 41 : * 42 : MSOUPO=IPCHP(1) 43 : JGM=NOCOMP(/2) 44 : SEGADJ MLMOTS 45 : DO 20 I=1,JGM 46 : MOTS(I)=NOCOMP(I) 47 : 20 CONTINUE 48 : SEGDES MSOUPO 49 : * 50 : IF (IPCHP(/1).NE.1) THEN 51 : DO 30 I=2,IPCHP(/1) 52 : MSOUPO=IPCHP(I) 53 : DO 40 K=1,NOCOMP(/2) 54 : DO 50 J=1,JGM 55 : IF (MOTS(J).EQ.NOCOMP(K)) GOTO 40 56 : 50 CONTINUE 57 : JGM=JGM+1 58 : SEGADJ MLMOTS 59 : MOTS(JGM)=NOCOMP(K) 60 : 40 CONTINUE 61 : SEGDES MSOUPO 62 : 30 CONTINUE 63 : ENDIF 64 : * 65 : 90 SEGDES MLMOTS,MCHPOI 66 : RETURN 67 : END 68 :
© Cast3M 2003 - All rights reserved.
Disclaimer