1 : C EXTR16 SOURCE GOUNAND 11/05/24 21:15:19 6976 2 : SUBROUTINE EXTR16(IRIG,IDUAL,MLMOTS) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *----------------------------------------------------------------------- 6 : * 7 : * E X T R 1 6 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * EXTRAIT LES NOMS DES COMPOSANTES OU DES DUALES D'UNE RIGIDITE 14 : * ET LES RANGE DANS UN LISTMOTS MLMOTS 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC SMRIGID 20 : -INC SMLMOTS 21 : * 22 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 23 : * ----------- 24 : * 25 : * IRIG (E) POINTEUR SUR LA RIGIDITE 26 : * IDUAL (E) 1 SI ON VEUT LES DUALES, 0 SINON 27 : * MLMOTS (S) POINTEUR SUR LE LISTMOTS 28 : * 29 : *----------------------------------------------------------------------- 30 : * 31 : * 32 : MRIGID = IRIG 33 : SEGACT MRIGID 34 : JGN=4 35 : JGM=0 36 : SEGINI MLMOTS 37 : IF (IRIGEL(/2).EQ.0) GO TO 90 38 : IF (IRIGEL(/1).LT.3) GO TO 90 39 : * 40 : DO 30 I=1,IRIGEL(/2) 41 : DESCR =IRIGEL(3,I) 42 : SEGACT DESCR 43 : IF (IDUAL.EQ.0) THEN 44 : NK=LISINC(/2) 45 : ELSE 46 : NK=LISDUA(/2) 47 : ENDIF 48 : DO 40 K=1,NK 49 : DO 50 J=1,JGM 50 : IF(IDUAL.EQ.0) THEN 51 : IF (MOTS(J).EQ.LISINC(K)) GOTO 40 52 : ELSE 53 : IF (MOTS(J).EQ.LISDUA(K)) GOTO 40 54 : ENDIF 55 : 50 CONTINUE 56 : JGM=JGM+1 57 : SEGADJ MLMOTS 58 : IF(IDUAL.EQ.0) THEN 59 : MOTS(JGM)=LISINC(K) 60 : ELSE 61 : MOTS(JGM)=LISDUA(K) 62 : ENDIF 63 : 40 CONTINUE 64 : SEGDES DESCR 65 : 30 CONTINUE 66 : * 67 : 90 SEGDES MLMOTS,MRIGID 68 : RETURN 69 : END 70 : 71 : 72 : 73 : 74 : 75 : 76 :
© Cast3M 2003 - All rights reserved.
Disclaimer